home *** CD-ROM | disk | FTP | other *** search
- ⓪ IMPLEMENTATION MODULE Convert; (* V#130 *)⓪ (*$Y+,R-,C-,X+,H+ *)⓪ (*$M- muß global sein, weil sonst dummy-Verkettungen zw. den Tables bleiben *)⓪ (*$J- ist nötig für ConvReal! *)⓪ ⓪ (* !!! Noch zu implementieren: Wenn bei Get-Routinen DEL-Zeichen⓪'geholt wird, dies richtig auswerten.⓪ ⓪#14.06.87 jm Atari-Realformat eingeführt⓪#18.06.87 jm in ConvFix & ConvEng hoffentlich ordentliche Rundung.⓪1Jetzt Ausgabe von max. 14 signifikanten Stellen;⓪1dazu RoundKonst-Tabelle um einen Eintrag erweitert.⓪#19.06.87 jm ConvLInt & ConvLCard raus⓪#22.06.87 TT Neben SPACE wird auch TAB am Anfang überlesen⓪#08.07.87 TT TRAP-Nummern korrigiert; 'ten' liefert valid-Wert statt TRAP⓪1auszulösen; Reg D3-D7 überall gerettet;⓪1Scanning erreicht immer Aufrufer.⓪#27.10.87 jm Rundung in ConvFix, ConvEng nochmals korrigiert⓪#01.03.88 TT ConvFix, ConvEng: ten-Aufruf: valid-Argument fehlte,⓪3führte zu Addreß/Buserrors.⓪#01.04.88 TT ConvReal entscheidet nun richtig zw. Float/Fix.⓪ ⓪#20.06.88 ubu Convert-procs f. 68020/881 eingebaut.⓪#26.08.88 MR Convert-procs f. 68881-solo.⓪ ⓪#10.09.88 TT ConvToLNum, ConvToNum bei allen Basen korrekt.⓪#17.09.88 TT ConvToLNum bei Zahlen > 16 Bit korrekt⓪#16.04.89 TT ConvFix/Eng runden richtig (roundKonst -> half)⓪#12.06.89 TT Kein String-Overflow bei WriteFix & optimiertem Linken⓪#15.06.89 TT Include-File f. Prozessoren⓪#16.06.89 TT ConvToReal f. A68881 rief Buserror bei neg. Mantisse hervor,⓪3weil ein '#' fehlte (es war da ein Space - ein Datenfehler?)⓪1Für FPU Error-Behandlung überarbeitet.⓪#17.06.89 TT ConvFloat/Fix/Eng von GS übernommen - CFloat aber noch nicht,⓪3weil da erst Anpassung der A68881-Routinen nötig ist!⓪#18.08.89 TT fillchar-Parameter bei ConvNum⓪#06.03.90 TT Rundung bei ConvFix/ConvEng korrigiert: Bei max. Mantisse wird⓪314 statt 13 nach D0 geladen⓪#30.05.90 TT ConvFix/Eng lösen bei FPU-Benutzung keinen Fehler bei 0.0 aus⓪#04.07.90 TT alte Runtime-Aufrufe raus⓪#17.10.90 TT ST-FPU: ConvToReal setzt bei Error die FPU zurück und räumt⓪1Stack korrekt ab.⓪#24.10.90 TT $H+ implementiert⓪#19.02.91 TT Ein paar mehr Warteschleifen für ST-FPU; keine Laufzeitfehler⓪1mehr bei TT-FPU (nicht getestet).⓪#25.03.91 TT ConvToNum/ConvToLNum wieder korrekt bei Werten > 256.⓪#28.02.91 TT Laufzeitfehler bei TT-FPU getestet/korrigiert.⓪#08.02.94 TT Kein Byte-Zugriff mehr auf fpstat+1 wg. STE.⓪#15.02.94 TT Warteschleife bei 'movl3' hinzugefügt.⓪ *)⓪ ⓪ FROM SYSTEM IMPORT CompilerVersion, ASSEMBLER, LONGWORD, WORD, ADDRESS;⓪ FROM MOSConfig IMPORT RadixChar, FixToFloatMin, FixToFloatMax;⓪ FROM MOSGlobals IMPORT StringOverflow, Overflow, OutOfRange;⓪ FROM SFP004 IMPORT FPUReset, FPUError;⓪ ⓪ (*$I FPU.CNF *)⓪ ⓪ (*$? A68881:⓪ CONST⓪(fpstat = $fffa40; (* Response word of MC68881 read *)⓪(fpctrl = $fffa42; (* Control word of MC68881 write *)⓪(fpcmd = $fffa4a; (* Command word of MC68881 write *)⓪(fpcond = $fffa4e; (* Condition word of MC68881 write *)⓪(fpop = $fffa50; (* Operand long of MC68881 read/write *)⓪ *)⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE @RMUL;⓪"BEGIN⓪$ASSEMBLER⓪(SUBQ.L #8,A3⓪(MOVE.L A3,A0⓪(LEA -8(A3),A1⓪(JMP @LMUL⓪$END⓪"END @RMUL;⓪ ⓪ (*$L-*)⓪ PROCEDURE @RADD;⓪"BEGIN⓪$ASSEMBLER⓪(SUBQ.L #8,A3⓪(MOVE.L A3,A0⓪(LEA -8(A3),A1⓪(JMP @LADD⓪$END⓪"END @RADD;⓪ ⓪ (*$L-*)⓪ PROCEDURE @RDIV;⓪"BEGIN⓪$ASSEMBLER⓪(SUBQ.L #8,A3⓪(MOVE.L A3,A0⓪(LEA -8(A3),A1⓪(JMP @LDIV⓪$END⓪"END @RDIV;⓪ ⓪ ⓪ TYPE LStr = RECORD⓪-p:POINTER TO ARRAY [0..0] OF CHAR;⓪-h:Cardinal;⓪-l:Cardinal;⓪+END;⓪ ⓪ (*$L-*)⓪ PROCEDURE getch;⓪ BEGIN⓪ ASSEMBLER⓪(MOVEM.L D0/D2/A0/A1/A2,-(A7)⓪(MOVE.L A2,(A3)+ ; ^ GetInfo⓪(MOVE.L (A0)+,A1⓪(MOVE.L (A0),D2⓪(JSR (A1)⓪(MOVEM.L (A7)+,D0/D2/A0/A1/A2⓪(MOVEQ #0,D1⓪(MOVE.B GetInfo.ch(A2),D1⓪(CMPI.B #$5F,D1⓪(BLE getch1⓪(BCLR #5,D1⓪ !getch1⓪ END⓪ END getch;⓪ ⓪ (*$L-*)⓪ PROCEDURE StrToLC;⓪ BEGIN⓪ ASSEMBLER⓪(CMPI #'+',D1⓪(BNE noplus⓪(JSR getch⓪ !noplus CMPI #'%',D1⓪(BEQ bin⓪(CMPI #'$',D1⓪(BNE.L dez⓪(BRA hex⓪ ⓪ finis2 BRA.L finis⓪ ⓪ !hex JSR getch⓪(SUBI.B #'0',D1⓪(BCS finis2⓪(CMPI.B #9,D1⓪(BLS hex1⓪(SUBQ.B #7,D1⓪(CMPI.B #$A,D1⓪(BCS finis2⓪(CMPI.B #$F,D1⓪(BHI finis2⓪ !hex1 MOVE D1,D0⓪(MOVEQ #1,D2⓪ hex2 JSR getch⓪(SUBI.B #'0',D1⓪(BCS finis2⓪(CMPI.B #9,D1⓪(BLS hex3⓪(SUBQ.B #7,D1⓪(CMPI.B #$A,D1⓪(BCS finis2⓪(CMPI.B #$F,D1⓪(BHI finis2⓪ !hex3 ROL.L #4,D0⓪(MOVE.B D0,D5⓪(ANDI #$F,D5⓪(BNE hex4⓪ hex5 OR.B D1,D0⓪(BRA hex2⓪ hex4 MOVEQ #0,D2⓪(ANDI.B #$F0,D0⓪(BRA hex5⓪ ⓪ !bin JSR getch⓪(SUBI.B #'0',D1⓪(BCS finis⓪(CMPI.B #1,D1⓪(BHI finis2⓪(MOVE.B D1,D0⓪(MOVEQ #1,D2⓪ !bin2 JSR getch⓪(SUBI.B #'0',D1⓪(BCS finis2⓪(CMPI.B #1,D1⓪(BHI finis2⓪(ASL.L #1,D0⓪(BCC bin3⓪(MOVEQ #0,D2 ; overflow⓪ bin3 OR.B D1,D0⓪(BRA bin2⓪(⓪ !dez SUBI.B #'0',D1⓪(BCS finis⓪(CMPI.B #9,D1⓪(BHI finis⓪(MOVE D1,D0⓪(MOVE #1,D2⓪(JSR getch⓪ dez2 SUBI.B #'0',D1⓪(BCS finis⓪(CMPI.B #9,D1⓪(BHI finis⓪(MOVE.L D0,D5⓪(LSL.L #1,D5⓪(BCS dez3⓪(LSL.L #1,D5⓪(BCS dez3⓪(ADD.L D5,D0⓪(BCS dez3⓪(LSL.L #1,D0⓪(BCS dez3⓪(ADD.L D1,D0⓪ dez4 JSR getch⓪(BRA dez2⓪ dez3 MOVEQ #0,D2⓪(BRA dez4⓪ finis⓪ END⓪ END StrToLC;⓪ ⓪ (*$L-*)⓪ PROCEDURE skip; (* Überliest Spaces und TABs *)⓪"BEGIN⓪$ASSEMBLER⓪%l: JSR getch⓪(CMPI #' ',D1⓪(BEQ l⓪(CMPI #9,D1 ; TAB⓪(BEQ l⓪$END⓪"END skip;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvToLCard( get : GetProc;⓪6VAR info : GetInfo;⓪6VAR valid : BOOLEAN ): LONGCARD;⓪ BEGIN⓪ ASSEMBLER⓪(MOVEM.L D3-D6,-(A7)⓪(MOVE.L -(A3),A1⓪(MOVE.L -(A3),A2⓪(LEA -8(A3),A0⓪(MOVEQ #0,D0⓪(MOVEQ #0,D2⓪(JSR skip⓪(JSR StrToLC⓪(MOVE D2,(A1) ; valid⓪(SUBQ.L #8,A3⓪(MOVE.L D0,(A3)+⓪(MOVEM.L (A7)+,D3-D6⓪ END⓪ END ConvToLCard;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvToCard( get : GetProc;⓪4VAR info : GetInfo;⓪4VAR valid : BOOLEAN ): CARDINAL;⓪ BEGIN⓪ ASSEMBLER⓪(JSR ConvToLCard⓪(MOVE -(A3),D0⓪(TST -(A3)⓪(BEQ finis⓪(CLR (A1) ; valid⓪ !finis MOVE D0,(A3)+⓪ END⓪ END ConvToCard;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvToLInt( get : GetProc;⓪4VAR info : GetInfo;⓪4VAR valid : BOOLEAN ): LONGINT;⓪ BEGIN⓪ ASSEMBLER⓪(MOVEM.L D3-D6,-(A7)⓪(MOVE.L -(A3),A1⓪(MOVE.L -(A3),A2⓪(LEA -8(A3),A0⓪(MOVEQ #0,D0 ;Ergebnis⓪(MOVEQ #0,D2 ;Valid⓪(JSR skip⓪(CMPI #'-',D1⓪(SEQ D6⓪(BNE nosign⓪(JSR getch⓪ !nosign JSR StrToLC⓪(TST.B D6⓪(BEQ finis1⓪(NEG.L D0⓪ !finis1 MOVE D2,(A1) ; valid⓪(SUBQ.L #8,A3⓪(MOVE.L D0,(A3)+⓪(MOVEM.L (A7)+,D3-D6⓪ END⓪ END ConvToLInt;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvToInt( get : GetProc;⓪4VAR info : GetInfo;⓪4VAR valid : BOOLEAN ): INTEGER;⓪ BEGIN⓪ ASSEMBLER⓪(JSR ConvToLInt⓪(MOVE -2(A3),D0⓪(EXT.L D0⓪(MOVE.L -(A3),D1⓪(CMP.L D0,D1⓪(BEQ finis⓪(CLR (A1) ; valid⓪ !finis MOVE D0,(A3)+⓪ END⓪ END ConvToInt;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvLN;⓪ BEGIN⓪ ASSEMBLER⓪ hex SUBI.B #'0',D1⓪(BCS finis⓪(CMPI.B #9,D1⓪(BLS hex1⓪(SUBQ.B #7,D1⓪(CMPI.B #$A,D1⓪(BCS finis⓪ !hex1 CMP.B D5,D1⓪(BCC finis⓪(TST D2⓪(BMI inval ; zahl nicht mehr gültig⓪(MOVEQ #1,D2 ; valid:= TRUE⓪(; Long-Multiplikation⓪(MOVE.L D0,D6⓪(MULU D5,D0⓪(SWAP D6⓪(TST.W D6⓪(BEQ ok⓪(MULU D5,D6⓪(SWAP D6⓪(TST.W D6⓪(BNE notval⓪(ADD.L D6,D0⓪(BCC ok⓪ notval MOVEQ #-1,D2⓪ ok ADD.L D1,D0⓪ inval JSR getch⓪(BRA hex⓪ ⓪ !finis TST D2⓪(BPL ende⓪(MOVEQ #0,D2⓪ ende⓪ END⓪ END ConvLN;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvToLNum ( get : GetProc;⓪6VAR info : GetInfo;⓪:base : CARDINAL;⓪6VAR valid : BOOLEAN ): LONGCARD;⓪ BEGIN⓪ ASSEMBLER⓪(MOVEM.L D3-D6,-(A7)⓪(MOVE.L -(A3),A1⓪(MOVE -(A3),D5⓪(MOVE.L -(A3),A2⓪(LEA -8(A3),A0⓪(CLR.B GetInfo.ch(A2)⓪(MOVEQ #0,D0⓪(MOVEQ #0,D2⓪(JSR skip⓪(CMPI #1,D5⓪(BLS err⓪(CMPI #36,D5⓪(BHI err⓪(JSR ConvLN⓪ err MOVE D2,(A1) ; valid⓪(SUBQ.L #8,A3⓪(MOVE.L D0,(A3)+⓪(MOVEM.L (A7)+,D3-D6⓪ END⓪ END ConvToLNum;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvToNum ( get : GetProc;⓪4VAR info : GetInfo;⓪8base : CARDINAL;⓪4VAR valid : BOOLEAN ): CARDINAL;⓪ BEGIN⓪ ASSEMBLER⓪(JSR ConvToLNum⓪(MOVE -(A3),D0⓪(TST -(A3)⓪(BEQ finis⓪(CLR (A1) ; valid⓪ !finis MOVE D0,(A3)+⓪ END⓪ END ConvToNum;⓪ ⓪ ⓪ TABLE.L eins: $000A8000,$00000000;⓪(tenpot: $0022A000,$00000000,$003AC800,$00000000,⓪0$00729C40,$00000000,$00DABEBC,$20000000,⓪0$01B28E1B,$C9BF0400,$035A9DC5,$ADA82B70,⓪0$06AAC278,$1F49FFCD,$0D5293BA,$47C980E5,⓪0$1A9AAA7E,$EBFB9DEF,$352AE319,$A0AEA5F1,⓪0$6952C976,$75868140;⓪ ⓪ (*$L-*)⓪ PROCEDURE ten(e:INTEGER; VAR valid: BOOLEAN):LONGREAL; (* / *)⓪ BEGIN⓪ ASSEMBLER⓪(;ten:= 10 ^ e⓪(MOVE D6,-(A7)⓪(MOVE.L -(A3),A1 ;A1: ADR (valid)⓪(LEA @LMUL,A2 ;A2: @LMUL/@LDIV⓪(MOVE -(A3),D6⓪(BPL check⓪(LEA @LDIV,A2⓪(NEG D6⓪(BPL check⓪(CLR D6⓪ !check CMPI #1232,D6⓪(BCS ok⓪(CLR.W (A1) ;valid:=FALSE⓪(CLR.L (A3)+⓪(CLR.L (A3)+⓪(MOVE (A7)+,D6⓪(RTS⓪ !ok LEA tenpot,A0 ;A0: ADR(tenpot-tbl)⓪(MOVE.L A3,A1 ;A1: ADR(result)⓪(MOVE.L eins,(A3)+⓪(CLR.L (A3)+⓪ !lbl BTST #0,D6⓪(BEQ notodd⓪(MOVEM.L A0-A2,-(A7)⓪(JSR (A2)⓪(MOVEM.L (A7)+,A0-A2⓪ !notodd ADDQ.L #8,A0⓪(ASR #1,D6⓪(BNE lbl⓪(MOVE (A7)+,D6⓪ END⓪ END ten;⓪ ⓪ (*$L+*)⓪ ⓪ (*$? ~M68881 AND ~A68881:⓪ ⓪ PROCEDURE ConvToReal( get : GetProc; (* / *)⓪5VAR info : GetInfo;⓪5VAR valid : BOOLEAN ): LONGREAL;⓪ ⓪ VAR mneg, eneg, isdigit: BOOLEAN;⓪6i: CARDINAL;⓪4exp: INTEGER;⓪6c: CHAR;⓪6x: LONGREAL;⓪ BEGIN⓪"ASSEMBLER⓪*MOVEM.L D3-D6,-(A7)⓪*BRA start⓪*⓪"!chrget MOVE.L A0,-(A7)⓪*MOVE.L info(A6),(A3)+⓪*MOVE.L get(A6),A0⓪*MOVE.L get+4(A6),D2⓪*JSR (A0)⓪*MOVE.L (A7)+,A0⓪*MOVE.L info(A6),A1⓪*MOVEQ #0,D0⓪*MOVE.B GetInfo.ch(A1),D0⓪*MOVE.B D0,c(A6)⓪*SUBI.B #'0',D0⓪*CMPI.B #9,D0⓪*SLS D2⓪"!nodig MOVE.B D2,isdigit(A6)⓪*RTS⓪*⓪"!mulx10 LEA x(A6),A0⓪*MOVE.L (A0)+,(A3)+⓪*MOVE.L (A0),(A3)+⓪*LEA tenpot,A0⓪*MOVE.L (A0)+,(A3)+⓪*MOVE.L (A0),(A3)+⓪*JSR @RMUL⓪*MOVEQ #0,D0⓪*MOVE.B c(A6),D0⓪*SUBI.B #'0',D0⓪*MOVE.L A3,A0⓪*ADDQ.L #8,A3⓪*JSR @LC2D⓪*JSR @RADD⓪*LEA x(A6),A0⓪*MOVE.L -(A3),4(A0)⓪*MOVE.L -(A3),(A0)⓪*TST (A0)⓪*BEQ nosig⓪*ADDQ #1,i(A6)⓪"!nosig RTS⓪*⓪"!start MOVE.L valid(A6),A1⓪*CLR (A1)⓪"!skpblk BSR chrget⓪*CMPI.B #' ',c(A6)⓪*BEQ skpblk⓪*CMPI.B #9,c(A6) ; TAB⓪*BEQ skpblk⓪*⓪*CMPI.B #'-',c(A6)⓪*SEQ mneg(A6)⓪*BNE nomneg⓪*BSR chrget⓪"!nomneg CMPI.B #'+',c(A6)⓪*BNE nompos⓪*BSR chrget⓪"!nompos LEA x(A6),A0⓪*CLR.L (A0)+⓪*CLR.L (A0)⓪*CLR i(A6)⓪*CLR exp(A6)⓪"!mant1 TST.B isdigit(A6)⓪*BEQ point⓪*MOVE.L valid(A6),A1⓪*MOVE #1,(A1)⓪*CMPI #14,i(A6)⓪*BGE dont⓪*BSR mulx10⓪*BRA inci⓪"!dont ADDQ #1,exp(A6)⓪"!inci BSR chrget⓪*BRA mant1⓪"!point MOVE.B c(A6),D0⓪*CMP.B RadixChar,D0⓪*BNE expon⓪*BSR chrget⓪"!mant2 TST.B isdigit(A6)⓪*BEQ expon⓪*MOVE.L valid(A6),A1⓪*MOVE #1,(A1)⓪*CMPI #14,i(A6)⓪*BGE dont1⓪*BSR mulx10⓪*SUBQ #1,exp(A6)⓪"!dont1 BSR chrget⓪*BRA mant2⓪"!expon CMPI.B #'E',c(A6)⓪*BEQ expon0⓪*CMPI.B #'e',c(A6)⓪*BNE retrn⓪"!expon0 BSR chrget⓪*CMPI.B #'-',c(A6)⓪*SEQ eneg(A6)⓪*BNE noeneg⓪*BSR chrget⓪"!noeneg CMPI.B #'+',c(A6)⓪*BNE noepos⓪*BSR chrget⓪"!noepos CLR i(A6)⓪"!expon1 TST.B isdigit(A6)⓪*BEQ expon2⓪*MOVE i(A6),D0⓪*MULU #10,D0⓪*MOVE.B c(A6),D1⓪*ANDI #$F,D1⓪*ADD D1,D0⓪*MOVE D0,i(A6)⓪*BSR chrget⓪*BRA expon1⓪"!expon2 MOVE i(A6),D0⓪*TST.B eneg(A6)⓪*BEQ expon3⓪*NEG D0⓪"!expon3 ADD D0,exp(A6)⓪"!retrn TST.B mneg(A6)⓪*BEQ retrn1⓪*TST x(A6)⓪*BEQ retrn1⓪*BSET #0,x+1(A6) ;jm 14.6.⓪"!retrn1 MOVEM.L (A7)+,D3-D6⓪"END;⓪"RETURN x * ten(exp,valid)⓪ END ConvToReal;⓪ ⓪%(* <-- 68000 *) *)⓪ ⓪ (*$? M68881 OR A68881:⓪ ⓪ PROCEDURE ConvToReal( get : GetProc; (* / *)⓪5VAR info : GetInfo;⓪5VAR valid : BOOLEAN ): LONGREAL;⓪ ⓪ VAR mneg, eneg, isdigit: BOOLEAN;⓪6i: CARDINAL;⓪4exp: INTEGER;⓪6c: CHAR;⓪6x: LONGREAL;⓪ BEGIN⓪"ASSEMBLER⓪"(*$? M68881:⓪*FMOVE.L FPCR,-(A7)⓪*FMOVE.L #0,FPCR ; keine Exceptions auslösen⓪"*)⓪*MOVE.L D3,-(A7)⓪*BRA.L start⓪ ⓪"!chrget MOVE.L A0,-(A7)⓪*MOVE.L info(A6),(A3)+⓪*MOVE.L get(A6),A0⓪*MOVE.L get+4(A6),D2⓪*JSR (A0)⓪*MOVE.L (A7)+,A0⓪*MOVE.L info(A6),A1⓪*MOVEQ #0,D0⓪*MOVE.B GetInfo.ch(A1),D0⓪*MOVE.B D0,c(A6)⓪*SUBI.B #'0',D0⓪*CMPI.B #9,D0⓪*SLS D2⓪"!nodig MOVE.B D2,isdigit(A6)⓪*RTS⓪ ⓪"(*$? M68881:⓪"Error MOVE.L valid(A6),A1⓪*CLR.W (A1)⓪*RTS⓪"!mulx10 (* x in FP0 *)⓪*FMOVE.L #0,FPSR ; Accrued Exc Byte löschen⓪*FMUL.W #10,FP0⓪*MOVEQ #0,D0⓪*MOVE.B c(A6),D0⓪*SUBI.B #'0',D0⓪*FADD.W D0,FP0⓪*FMOVE.L FPSR,D0⓪*ANDI.B #11010000%,D0 ; InvalidOperation, Overflow oder DivByZero?⓪*BNE Error⓪*RTS⓪"*)⓪"(*$? A68881:⓪#Error MOVE.L valid(A6),A1⓪*CLR.W (A1)⓪*JMP FPUReset⓪"!mulx10 (* x in FP0 *)⓪*MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ mulx10⓪*MOVE.W #$5023,fpcmd ; FMUL.W⓪"!mulxl MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ mulxl⓪*SUBQ.B #2,D0⓪*BNE Error⓪*MOVE.W #10,fpop ; #10⓪*MOVEQ #0,D2⓪*MOVE.B c(A6),D2⓪*TST.W fpstat⓪*SUBI.B #'0',D2⓪#!addx2 MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ addx2⓪*MOVE.W #$5022,fpcmd ; FADD.W⓪#!addxl MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ addxl⓪*SUBQ.B #2,D0⓪*BNE Error⓪*MOVE.W D2,fpop ; digit addieren⓪#!addx3 MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ addx3⓪*SUBQ.B #2,D0⓪*BNE Error⓪*RTS⓪#⓪#protViol⓪*JSR FPUError⓪*BRA.W error2⓪"*)⓪ ⓪"!start MOVE.L valid(A6),A1⓪*CLR (A1)⓪"!skpblk BSR chrget⓪*CMPI.B #' ',c(A6)⓪*BEQ skpblk⓪*CMPI.B #9,c(A6) ; TAB⓪*BEQ skpblk⓪*⓪*CMPI.B #'-',c(A6)⓪*SEQ mneg(A6)⓪*BNE nomneg⓪*BSR chrget⓪"!nomneg CMPI.B #'+',c(A6)⓪*BNE nompos⓪*BSR chrget⓪*⓪"(*$? M68881:⓪"!nompos⓪*FMOVE.W #0,FP0⓪"*)⓪"(*$? A68881:⓪"!nompos MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ nompos⓪*SUBQ.B #2,D0⓪*BEQ noError⓪*JSR FPUError⓪"noError MOVE.W #$5C0F,fpcmd ; FMOVECR 0.0,FP0⓪"waitFpu MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ waitFpu⓪*SUBQ.B #2,D0⓪*BNE protViol⓪"*)⓪*CLR exp(A6)⓪"!mant1 TST.B isdigit(A6)⓪*BEQ point⓪*MOVE.L valid(A6),A1⓪*MOVE #1,(A1)⓪*BSR mulx10⓪*MOVE.L valid(A6),A1⓪*TST.W (A1)⓪*BEQ.W error2⓪"!inci BSR chrget⓪*BRA mant1⓪"!point MOVE.B c(A6),D0⓪*CMP.B RadixChar,D0⓪*BNE expon⓪*BSR chrget⓪"!mant2 TST.B isdigit(A6)⓪*BEQ expon⓪*MOVE.L valid(A6),A1⓪*MOVE #1,(A1)⓪*BSR mulx10⓪*SUBQ #1,exp(A6)⓪"!dont1 BSR chrget⓪*BRA mant2⓪"!expon CMPI.B #'E',c(A6)⓪*BEQ expon0⓪*CMPI.B #'e',c(A6)⓪*BNE retrn⓪"!expon0 BSR chrget⓪*CLR eneg(A6)⓪*CMPI.B #'-',c(A6)⓪*SEQ eneg(A6)⓪*BNE noeneg⓪*BSR chrget⓪"!noeneg CMPI.B #'+',c(A6)⓪*BNE noepos⓪*BSR chrget⓪"!noepos CLR D3⓪"!expon1 TST.B isdigit(A6)⓪*BEQ expon2⓪*MULU #10,D3⓪*MOVE.B c(A6),D1⓪*ANDI #$F,D1⓪*ADD D1,D3⓪*BSR chrget⓪*BRA expon1⓪"!expon2⓪*TST.B eneg(A6)⓪*BEQ expon3⓪*NEG D3⓪"!expon3 ADD.W exp(A6),D3⓪*MOVE.W D3,D0⓪*BPL testex⓪*NEG D0⓪"!testex CMPI.W #307,D0⓪*BLE expon4⓪*MOVE.L valid(A6),A1⓪*CLR.W (A1)⓪"!expon4 MOVE.W D3,exp(A6)⓪"!retrn TST.B mneg(A6)⓪*BEQ retrn1⓪ (*$? M68881:⓪*FMOVE.L #0,FPSR ; Accrued Exc Byte löschen⓪*FTST.X FP0⓪*FBEQ retrn1⓪*FNEG.X FP0⓪"!retrn1 MOVE.L (A7)+,D3⓪*FTENTOX.W exp(A6),FP1⓪*FMUL.X FP1,FP0⓪*FMOVE.D FP0,x(A6)⓪*FMOVE.L FPSR,D0⓪*FMOVE.L (A7)+,FPCR⓪*ANDI.B #11010000%,D0 ; InvalidOperation, Overflow oder DivByZero?⓪*BEQ ende⓪*MOVE.L valid(A6),A1⓪*CLR (A1)⓪*BRA error3⓪"error2 MOVE.L (A7)+,D3⓪*FMOVE.L (A7)+,FPCR⓪"error3 CLR.L x(A6)⓪*CLR.L x+4(A6)⓪ *)⓪ (*$? A68881:⓪"!tst2 MOVE.W fpstat,D3⓪*TST.B D3⓪*BEQ tst2⓪*MOVE.W #$3A,fpcmd ; FTST FP0⓪"!tstl MOVE.W fpstat,D3⓪*TST.B D3⓪*BEQ tstl⓪*MOVE.W #1,fpcond ; FBEQ retrn1⓪*MOVE.W fpstat,D3 ; Response⓪*CMPI.W #$0802,fpstat⓪*BNE protviol⓪*TST.B D3⓪*BNE retrn1⓪*MOVE.W #$1A,fpcmd ; FNEG FP0⓪"!retrn1 MOVE.L (A7)+,D3⓪"!negl MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ negl⓪*MOVE.W #$5092,fpcmd ; FTENTOX.W ?,FP1⓪"!tenl MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ tenl⓪*SUBQ.B #2,D0⓪*BNE error1⓪*MOVE.W exp(A6),fpop⓪"!neg2 MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ neg2⓪*MOVE.W #$423,fpcmd ; FMUL FP1,FP0⓪"!mull MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ mull⓪*MOVE.W #$7400,fpcmd ; FMOVE.D FP0,?⓪"!movl1 MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ movl1⓪*SUBQ.B #8,D0⓪*BNE error1⓪*MOVE.L fpop,x(A6)⓪*TST.W fpstat⓪*MOVE.L fpop,x+4(A6)⓪$movl2 MOVE.W fpstat,D0⓪*TST.B D0⓪*BEQ movl2⓪*SUBQ.B #2,D0⓪*BEQ Ende⓪*BRA Error1⓪"Error2 MOVE.L (A7)+,D3⓪"Error1 JSR FPUReset⓪*CLR.L x(A6)⓪*CLR.L x+4(A6)⓪*MOVE.L valid(A6),A0⓪*CLR.W (A0)⓪ *)⓪&Ende⓪"END;⓪"RETURN x⓪ END ConvToReal;⓪ ⓪$(* <-- 68020 *) *)⓪ ⓪ (*$L-*)⓪ PROCEDURE reverse; (* ^str:A0, High(str):D5, space:D6, len(str):D4 *)⓪ BEGIN⓪ ASSEMBLER⓪(LEA 0(A0,D4.W),A1⓪(SUBQ #1,D6⓪(BCS revers⓪(CMP D5,D6⓪(BHI error⓪(SUB D4,D6⓪(BCS revers⓪(MOVE D5,D1⓪(SUB D4,D1⓪(BCS revers⓪(MOVE D7,D0⓪ !spclp MOVE.B D0,(A1)+⓪(ADDQ #1,D4⓪(SUBQ #1,D1⓪(DBCS D6,spclp⓪ !revers MOVE.L A0,-(A7)⓪ loop0 MOVE.B (A0),D0⓪(MOVE.B -(A1),(A0)+⓪(MOVE.B D0,(A1)⓪(CMPA.L A0,A1⓪(BHI loop0⓪(MOVE.L (A7)+,A0⓪(CMP D5,D4⓪(BHI finis⓪(CLR.B 0(A0,D4.W)⓪(BRA finis⓪ error TRAP #6⓪(DC.W StringOverflow-$4000 ; string overflow⓪ finis MOVEM.L (A7)+,D3-D7⓪(UNLK A5⓪ END⓪ END reverse;⓪ ⓪ (*$L-*)⓪ PROCEDURE LCToStr; (* lc:D3.L, ^str:A0, High(str):D5 => D4:len(str) *)⓪ BEGIN⓪ ASSEMBLER⓪(; D6 erhalten !⓪(MOVEQ #0,D4⓪ !lbl CMP D5,D4⓪(BHI error⓪(MOVEQ #10,D0⓪(MOVE.L D3,D1⓪(MOVEQ #0,D2⓪(MOVEQ #0,D3⓪ !cd1 CMP.L D0,D1⓪(BLS cd2⓪(ADDQ #1,D2⓪(ASL.L #1,D0⓪(BPL cd1⓪ !cd2 ASL.L #1,D3⓪(CMP.L D0,D1⓪(BCS cd3⓪(SUB.L D0,D1⓪(ADDQ.B #1,D3⓪ !cd3 LSR.L #1,D0⓪(DBF D2,cd2⓪(ADDI #'0',D1⓪(MOVE.B D1,0(A0,D4.W)⓪(ADDQ #1,D4⓪(TST.L D3⓪(BNE lbl⓪(RTS⓪ error TRAP #6⓪(DC.W StringOverflow-$4000 ; string overflow⓪ END⓪ END LCToStr;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvCard(lc:LONGCARD; space:CARDINAL; VAR str: ARRAY OF CHAR);⓪ BEGIN⓪ ASSEMBLER⓪(LINK A5,#0⓪(MOVEM.L D3-D7,-(A7)⓪(MOVE -(A3),D5 ; HIGH (str)⓪(MOVE.L -(A3),A0 ; ^str⓪(MOVE -(A3),D6 ; space⓪(MOVE.L -(A3),D3 ; lc⓪(JSR LCToStr⓪(MOVEQ #' ',D7⓪(JMP reverse⓪ END⓪ END ConvCard;⓪ ⓪ (*$L-*)⓪ PROCEDURE LItoStr;⓪ BEGIN⓪ ASSEMBLER⓪(TST.L D3⓪(BPL notneg⓪(NEG.L D3⓪(SUBQ.L #1,D5 ; HIGH verringern für '-' Zeichen⓪(BCS error⓪(JSR LCToStr⓪(ADDQ #1,D5⓪(MOVE.B #'-',0(A0,D4.W)⓪(ADDQ #1,D4⓪(BRA finis⓪ !notneg JSR LCToStr⓪ !finis MOVEQ #' ',D7⓪(JMP reverse⓪ error TRAP #6⓪(DC.W StringOverflow-$4000 ; string overflow⓪(MOVEM.L (A7)+,D3-D7⓪(UNLK A5⓪ END⓪ END LIToStr;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvInt(i:LONGINT; space:CARDINAL; VAR str: ARRAY OF CHAR);⓪ BEGIN⓪ ASSEMBLER⓪(LINK A5,#0⓪(MOVEM.L D3-D7,-(A7)⓪(MOVE -(A3),D5 ; HIGH (str)⓪(MOVE.L -(A3),A0 ; ^str⓪(MOVE -(A3),D6 ; space⓪(MOVE.L -(A3),D3⓪(JMP LItoStr⓪ END⓪ END ConvInt;⓪ ⓪ (*$L-*)⓪ PROCEDURE LHtoStr;⓪ BEGIN⓪ ASSEMBLER⓪(MOVEQ #0,D2⓪(SUBQ #1,D0⓪ !lbl CMP D5,D2⓪(BEQ error⓪(MOVE.B D1,D3⓪(ANDI.B #$F,D3⓪(ORI.B #'0',D3⓪(CMPI.B #'9',D3⓪(BLS noadd⓪(ADDQ.B #7,D3⓪ !noadd MOVE.B D3,0(A0,D2.W)⓪(ADDQ.B #1,D2⓪(BMI dollar ; Falls space zu groß⓪(SUBQ #1,D0⓪(LSR.L #4,D1⓪(BNE lbl⓪(TST D0⓪(BGT lbl⓪ dollar MOVE.B #'$',0(A0,D2.W)⓪(LEA 1(A0,D2.W),A1⓪ !revers MOVE.L A0,-(A7)⓪ l MOVE.B (A0),D1⓪(MOVE.B -(A1),(A0)+⓪(MOVE.B D1,(A1)⓪(CMPA.L A0,A1⓪(BHI l⓪(MOVE.L (A7)+,A0⓪(CMP D5,D2⓪(BEQ finis⓪(CLR.B 1(A0,D2.W)⓪(BRA finis⓪ error TRAP #6⓪(DC.W StringOverflow-$4000 ; string overflow⓪ !finis MOVEM.L (A7)+,D3-D6⓪(UNLK A5⓪ END⓪ END LHtoStr;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvLHex(l:LONGWORD; space:CARDINAL; VAR str: ARRAY OF CHAR);⓪ BEGIN⓪ ASSEMBLER⓪(LINK A5,#0⓪(MOVEM.L D3-D6,-(A7)⓪(MOVE -(A3),D5 ; HIGH (str)⓪(MOVE.L -(A3),A0 ; ^str⓪(MOVE -(A3),D0 ; space⓪(MOVE.L -(A3),D1 ; l⓪(JMP LHToStr⓪ END⓪ END ConvLHex;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvHex(w:WORD; space:CARDINAL; VAR str: ARRAY OF CHAR);⓪ BEGIN⓪ ASSEMBLER⓪(LINK A5,#0⓪(MOVEM.L D3-D6,-(A7)⓪(MOVE -(A3),D5 ; HIGH (str)⓪(MOVE.L -(A3),A0 ; ^str⓪(MOVE -(A3),D0 ; space⓪(MOVEQ #0,D1⓪(MOVE -(A3),D1⓪(JMP LHToStr⓪ END⓪ END ConvHex;⓪ ⓪ (*$L-*)⓪ PROCEDURE LBToStr;⓪ BEGIN⓪ ASSEMBLER⓪(MOVEQ #0,D2⓪(SUBQ #1,D0⓪ !lbl CMP D5,D2⓪(BEQ error⓪(MOVE.B D1,D3⓪(ANDI.B #$1,D3⓪(ORI.B #'0',D3⓪(MOVE.B D3,0(A0,D2.W)⓪(ADDQ.B #1,D2⓪(BMI proznt ; Falls space zu groß⓪(SUBQ #1,D0⓪(LSR.L #1,D1⓪(BNE lbl⓪(TST D0⓪(BGT lbl⓪ !proznt MOVE.B #'%',0(A0,D2.W)⓪(LEA 1(A0,D2.W),A1⓪ !revers MOVE.L A0,-(A7)⓪ l MOVE.B (A0),D1⓪(MOVE.B -(A1),(A0)+⓪(MOVE.B D1,(A1)⓪(CMPA.L A0,A1⓪(BHI l⓪(MOVE.L (A7)+,A0⓪(CMP D5,D2⓪(BEQ finis⓪(CLR.B 1(A0,D2.W)⓪(BRA finis⓪ error TRAP #6⓪(DC.W StringOverflow-$4000 ; string overflow⓪ !finis MOVEM.L (A7)+,D3-D6⓪(UNLK A5⓪ END⓪ END LBToStr;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvLBin(l:LONGWORD; space:CARDINAL; VAR str: ARRAY OF CHAR);⓪ BEGIN⓪ ASSEMBLER⓪(LINK A5,#0⓪(MOVEM.L D3-D6,-(A7)⓪(MOVE -(A3),D5 ; HIGH (str)⓪(MOVE.L -(A3),A0 ; ^str⓪(MOVE -(A3),D0 ; space⓪(MOVE.L -(A3),D1 ; l⓪(JMP LBToStr⓪ END⓪ END ConvLBin;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvBin(W:WORD; space:CARDINAL; VAR str: ARRAY OF CHAR);⓪ BEGIN⓪ ASSEMBLER⓪(LINK A5,#0⓪(MOVEM.L D3-D6,-(A7)⓪(MOVE -(A3),D5 ; HIGH (str)⓪(MOVE.L -(A3),A0 ; ^str⓪(MOVE -(A3),D0 ; space⓪(MOVEQ #0,D1⓪(MOVE -(A3),D1⓪(JMP LBToStr⓪ END⓪ END ConvBin;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvLNum(l:LONGWORD; base,space:CARDINAL; fillCh: CHAR;⓪(VAR str: ARRAY OF CHAR);⓪ BEGIN⓪ ASSEMBLER⓪(LINK A5,#0⓪(MOVEM.L D3-D7,-(A7)⓪(MOVE -(A3),D5 ; HIGH (str)⓪(MOVE.L -(A3),A0 ; ^str⓪(SUBQ.L #1,A3⓪(MOVE.B -(A3),D7 ; fillCh⓪(MOVE -(A3),D6 ; space⓪(MOVEQ #0,D2⓪(MOVE -(A3),D2 ; base⓪(MOVE.L -(A3),D1 ; l⓪(CMPI #1,D2⓪(BLS err⓪(CMPI #36,D2⓪(BLS ok⓪ ⓪ err CLR.B (A0)⓪(TRAP #6⓪(DC.W OutOfRange-$4000⓪(MOVEM.L (A7)+,D3-D7⓪(UNLK A5⓪(RTS⓪ ⓪ ok MOVEQ #0,D4⓪ !lbl CMP D5,D4 ; HIGH (str) erreicht ?⓪(BHI error⓪(MOVE.L D1,(A3)+⓪(MOVE.L D2,(A3)+⓪(MOVEM.L D1/D2,-(A7)⓪(JSR @CMOD⓪(MOVEM.L (A7)+,D1/D2⓪(MOVE.L -(A3),D3⓪(ADDI.B #'0',D3⓪(CMPI.B #'9',D3⓪(BLS noadd⓪(ADDQ.B #7,D3⓪ !noadd MOVE.B D3,0(A0,D4.W)⓪(ADDQ.B #1,D4⓪(BMI revers ; Falls space zu groß⓪(MOVE.L D1,(A3)+⓪(MOVE.L D2,(A3)+⓪(MOVEM.L D1-D2,-(A7)⓪(JSR @CDIV⓪(MOVEM.L (A7)+,D1-D2⓪(MOVE.L -(A3),D1⓪(BNE lbl⓪ revers JMP reverse⓪ error TRAP #6⓪(DC.W StringOverflow-$4000 ; string overflow⓪ !finis MOVEM.L (A7)+,D3-D7⓪(UNLK A5⓪ END⓪ END ConvLNum;⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvNum(w:WORD; base,space:CARDINAL; fillCh: CHAR;⓪0VAR str: ARRAY OF CHAR);⓪ BEGIN⓪ ASSEMBLER⓪(LINK A5,#0⓪(MOVEM.L D3-D7,-(A7)⓪(MOVE -(A3),D5 ; HIGH (str)⓪(MOVE.L -(A3),A0 ; ^str⓪(SUBQ.L #1,A3⓪(MOVE.B -(A3),D7 ; fillCh⓪(MOVE -(A3),D6 ; space⓪(MOVE -(A3),D2 ; base⓪(MOVEQ #0,D1⓪(MOVE -(A3),D1 ; w⓪(CMPI #1,D2⓪(BLS err⓪(CMPI #36,D2⓪(BLS ok⓪ ⓪ err CLR.B (A0)⓪(TRAP #6⓪(DC.W OutOfRange-$4000⓪(MOVEM.L (A7)+,D3-D7⓪(UNLK A5⓪(RTS⓪ ⓪ ok MOVEQ #0,D4⓪ !lbl CMP D5,D4 ; HIGH (str) erreicht ?⓪(BHI error⓪(DIVU D2,D1⓪(SWAP D1⓪(ADDI.B #'0',D1⓪(CMPI.B #'9',D1⓪(BLS noadd⓪(ADDQ.B #7,D1⓪ !noadd MOVE.B D1,0(A0,D4.W)⓪(ADDQ.B #1,D4⓪(BMI revers ; Falls space zu groß⓪(CLR D1⓪(SWAP D1⓪(BNE lbl⓪ revers JMP reverse⓪ error TRAP #6⓪(DC.W StringOverflow-$4000 ; string overflow⓪ !finis MOVEM.L (A7)+,D3-D7⓪(UNLK A5⓪ END⓪ END ConvNum;⓪ ⓪ ⓪ (*$? ~M68881 AND ~A68881:⓪ ⓪ TABLE.L zehntel: $FFEACCCC,$CCCCCCCC;⓪(half: $00028000,$00000000;⓪(roundkonst: $FFE2CCCC,$CCCCCCCC,$FFCAA3D7,$0A3D70A3,⓪4$FFB28312,$6E978D2F,$FF92D1B7,$1758E219,⓪4$FF7AA7C5,$AC471B47,$FF628637,$BD05AF6C,⓪4$FF42D6BF,$94D5E57A,$FF2AABCC,$77118461,⓪4$FF128970,$5F4136B4,$FEF2DBE6,$FECEBDED,⓪4$FEDAAFEB,$FF0BCB24,$FEC28CBC,$CC096F50,⓪4$FEA2E12E,$13424BB4,$FE8AB424,$DC358000;⓪ ⓪ (*$L-*)⓪ PROCEDURE norm;⓪"(*⓪&normiert Realzahl (A2) auf 0.1 <= (A2) < 1.0;⓪&korrigert dabei Integer-Exponent (A1).⓪"*)⓪ BEGIN⓪ ASSEMBLER⓪(;0.1<=x<1.0⓪(;A1:=^e; A2:=^x⓪(MOVE.L A1,-(A7)⓪(MOVE.L A2,-(A7)⓪ !norm0 MOVE.L (A7),A1⓪(LEA eins,A0⓪(JSR @LRGE⓪(TST D0⓪(BEQ norm1⓪(MOVE.L (A7),A1⓪(LEA tenpot,A0⓪(JSR @LDIV⓪(MOVE.L 4(A7),A1⓪(ADDQ #1,(A1)⓪(BRA norm0⓪ !norm1 MOVE.L (A7),A1⓪(LEA zehntel,A0⓪(JSR @LRLT⓪(TST D0⓪(BEQ norm2⓪(MOVE.L (A7),A1⓪(LEA tenpot,A0⓪(JSR @LMUL⓪(MOVE.L 4(A7),A1⓪(SUBQ #1,(A1)⓪(BRA norm1⓪ !norm2 ADDQ.L #8,A7⓪ END⓪ END norm;⓪ ⓪ ⓪ (*$L-*)⓪ PROCEDURE put;⓪ BEGIN⓪ ASSEMBLER⓪(;ein Zeichen in <line> zuweisen⓪(;A0:=^Str, D0:=Zeichen⓪(MOVE LStr.l(A0),D6⓪(CMP LStr.h(A0),D6⓪(BHI overfl⓪(ADDQ #1,LStr.l(A0)⓪(MOVE.L LStr.p(A0),A1⓪(MOVE.B D0,0(A1,D6.W)⓪(CMP D0,D0 ; liefert EQ⓪ overfl ; liefert NE⓪ END⓪ END put;⓪ ⓪ (*$L-*)⓪ PROCEDURE digit;⓪ BEGIN⓪ ASSEMBLER⓪(CMPI #13,D5⓪(BLS ok⓪(MOVEQ #0,D0⓪(BEQ digout⓪ !ok ADDQ #1,D5⓪(MOVE.L D0,D2 ;A0=^line, (D0,D1)=x⓪(MOVE.L D1,D3 ;benutzt D2,D3⓪(ASL.L #1,D3 ;D5=Zaehler⓪(ROXL.L #1,D2⓪(ASL.L #1,D3⓪(ROXL.L #1,D2⓪(ADD.L D3,D1⓪(ADDX.L D2,D0⓪(ASL.L #1,D1⓪(ROXL.L #1,D0⓪(SWAP D0⓪ !digout ORI #'0',D0⓪(JSR put⓪(BNE finis⓪(CLR D0⓪(SWAP D0⓪(CMP D0,D0 ; liefert EQ⓪ finis⓪ END⓪ END digit;⓪ ⓪ (*$L-*)⓪ PROCEDURE bintodezexp;⓪ BEGIN⓪ ASSEMBLER⓪(ASR.W #3,D2 ;jm 15.6.⓪(; EXT.L D2⓪(BPL noadd⓪(ADDQ.L #1,D2⓪ !noadd MULS #77,D2⓪(ASR.L #0,D2 ;das sind natürlich 8 Shifts! 77/256 ~ log 2⓪(BMI noadd1⓪(ADDQ #1,D2⓪ !noadd1⓪ END⓪ END bintodezexp;⓪ ⓪ (*$L-*)⓪ PROCEDURE insSpc ( VAR lin:ARRAY OF CHAR; len:Cardinal; spc:Cardinal );⓪ (* ^str:A0, High(str):D5, space:D6, len(str):D4 *)⓪ BEGIN⓪ ASSEMBLER⓪(MOVE -(A3),D6⓪(MOVE -(A3),D4⓪(MOVE -(A3),D5⓪(MOVE.L -4(A3),A0⓪(⓪(LEA 0(A0,D4.W),A1⓪ rev2 MOVE.B (A0),D0⓪(MOVE.B -(A1),(A0)+⓪(MOVE.B D0,(A1)⓪(CMPA.L A0,A1⓪(BHI rev2⓪(⓪(MOVE.L -(A3),A0⓪(⓪(LEA 0(A0,D4.W),A1⓪(SUBQ #1,D6⓪(BCS revers⓪(CMP D5,D6⓪(BHI error⓪(SUB D4,D6⓪(BCS revers⓪(MOVE D5,D1⓪(SUB D4,D1⓪(BCS revers⓪(MOVEQ #' ',D0⓪ !spclp MOVE.B D0,(A1)+⓪(ADDQ #1,D4⓪(SUBQ #1,D1⓪(DBCS D6,spclp⓪ !revers MOVE.L A0,-(A7)⓪ l MOVE.B (A0),D0⓪(MOVE.B -(A1),(A0)+⓪(MOVE.B D0,(A1)⓪(CMPA.L A0,A1⓪(BHI l⓪(MOVE.L (A7)+,A0⓪(CMP D5,D4⓪(BHI finis⓪(CLR.B 0(A0,D4.W)⓪(BRA finis⓪ error TRAP #6⓪(DC.W StringOverflow-$4000 ; string overflow⓪ finis⓪ END⓪ END insSpc;⓪ ⓪ (*$L+*)⓪ PROCEDURE ConvFloat(x:LONGREAL; space,n:CARDINAL; VAR lin: ARRAY OF CHAR);⓪ VAR e:INTEGER; line:LStr;⓪ BEGIN⓪"ASSEMBLER⓪*;1 Stelle vor, n nach Komma, E+-DDDD⓪*⓪*MOVEM.L D3-D6,-(A7)⓪*⓪*MOVE.L lin(A6),line.p(A6)⓪*MOVE.W lin+4(A6),line.h(A6) ; HIGH (lin)⓪*CLR.W line.l(A6)⓪*⓪*LEA line(A6),A0⓪*MOVE x(A6),D2⓪*BNE notzer⓪*MOVEQ #'0',D0 ;x = 0.0⓪*JSR put⓪*BNE.L overfl⓪*MOVE.B RadixChar,D0⓪*JSR put⓪*BNE.L overfl⓪*MOVEQ #'0',D0⓪*MOVE n(A6),D1⓪*BEQ nozero⓪"!zeros JSR put⓪*BNE.L overfl⓪*SUBQ #1,D1⓪*BNE zeros⓪"!nozero MOVE #1,e(A6)⓪*BRA.L putexp⓪"!notzer BCLR #0,D2 ;jm 14.6.⓪*BEQ notneg⓪*MOVE D2,x(A6) ;x < 0.0: jetzt positiv gemacht⓪*MOVEQ #'-',D0⓪*JSR put⓪*BNE.L overfl⓪"!notneg JSR bintodezexp⓪*MOVE D2,e(A6)⓪*LEA x(A6),A0 ;x:=x/ten(e)⓪*MOVE.L (A0)+,(A3)+⓪*MOVE.L (A0),(A3)+⓪*MOVE D2,(A3)+⓪*SUBQ.L #2,A7⓪*MOVE.L A7,(A3)+ ;'valid'-Para; nur dummy, weil Overflow unmöglich⓪*JSR ten⓪*ADDQ.L #2,A7⓪*JSR @RDIV⓪*LEA x(A6),A2 ;0.1<=x<1.0⓪*MOVE.L -(A3),4(A2)⓪*MOVE.L -(A3),(A2)⓪*LEA e(A6),A1⓪*JSR norm⓪*MOVE n(A6),D0 ;Runden: Anzahl Nachkommastellen⓪*CMPI #13,D0⓪*BLS okrund⓪*MOVEQ #13,D0⓪"!okrund ASL #3,D0⓪*LEA roundkonst,A0⓪*ADDA D0,A0 ;Zugriff auf 0.5 / 10^(n+1)⓪@; (beachte 0.1 <= Zahl < 1.0, daher n+1)⓪*MOVE.L (A0)+,(A3)+⓪*MOVE.L (A0),(A3)+⓪*LEA x(A6),A0⓪*MOVE.L (A0)+,(A3)+⓪*MOVE.L (A0),(A3)+⓪*JSR @RADD ;0.1<=x<1.0⓪*LEA x(A6),A2⓪*MOVE.L -(A3),4(A2)⓪*MOVE.L -(A3),(A2)⓪*LEA e(A6),A1⓪*JSR norm⓪*LEA x(A6),A0 ;trunc(x) in 48-bit Mantisse⓪*MOVE.L (A0)+,D0⓪*MOVE.L (A0),D1⓪*SWAP D0⓪*MOVE D0,D2 ;Exponentenwort⓪*CLR D0⓪*SWAP D0 ;in D0 Exp.wort geloescht⓪*⓪*ASR #3,D2⓪*BPL finis ;bei Exp >= 0 fertig⓪*NOT D2 ;Exp -1 ergibt Zählwert 0 in D2 (NEG D2, DEC D2)⓪*; SUBI #$0FFF,D2⓪*; BGT finis ;bei Exp > -1 fertig⓪*; NEG D2⓪"⓪"!shr LSR #1,D0⓪*ROXR.L #1,D1⓪*DBF D2,shr⓪*BCC finis ;evtl. aufrunden⓪*ADDQ.L #1,D1⓪*BCC finis⓪*ADDQ.W #1,D0⓪"!finis LEA line(A6),A0 ;Vorkommastelle berechnen⓪*MOVEQ #0,D5⓪*JSR digit⓪*BNE.L overfl⓪*MOVE.L D0,D2⓪*MOVE n(A6),D4⓪*BEQ putexp⓪*MOVE.B RadixChar,D0⓪*JSR put⓪*BNE.L overfl⓪*MOVE.L D2,D0⓪"!putman JSR digit ;n Nachkommastellen berechnen⓪*BNE.L overfl⓪*SUBQ #1,D4⓪*BNE putman⓪"!putexp SUBQ #1,e(A6)⓪*MOVEQ #'E',D0⓪*JSR put⓪*BNE.L overfl⓪*MOVEQ #'+',D0⓪*MOVE e(A6),D1⓪*BPL posit⓪*NEG D1⓪*MOVEQ #'-',D0⓪"!posit JSR put⓪*BNE.L overfl⓪*MOVE D1,D0⓪*MOVEQ #'0',D1⓪*DIVU #1000,D0⓪*OR D1,D0⓪*JSR put⓪*BNE.L overfl⓪*CLR D0⓪*SWAP D0⓪*DIVU #100,D0⓪*OR D1,D0⓪*JSR put⓪*BNE.L overfl⓪*CLR D0⓪*SWAP D0⓪*DIVU #10,D0⓪*OR D1,D0⓪*JSR put⓪*BNE overfl⓪*SWAP D0⓪*OR D1,D0⓪*JSR put⓪*BNE overfl⓪"END;⓪"insSpc (lin,line.l,space);⓪"ASSEMBLER⓪*BRA ende⓪"overfl TRAP #6⓪*DC.W StringOverflow-$4000 ; string overflow⓪"ende MOVEM.L (A7)+,D3-D6⓪"END⓪ END ConvFloat;⓪ ⓪ (*$L+*)⓪ PROCEDURE ConvEng(x:LONGREAL; space,n:CARDINAL; VAR lin: ARRAY OF CHAR);⓪ VAR line:LStr;⓪$e:INTEGER;⓪ BEGIN⓪"ASSEMBLER⓪*;1-3 Stelle vor, n nach Komma, E+-DDDD⓪*⓪*MOVEM.L D3-D6,-(A7)⓪*⓪*MOVE.L lin(A6),line.p(A6)⓪*MOVE.W lin+4(A6),line.h(A6) ; HIGH (lin)⓪*CLR.W line.l(A6)⓪*⓪*LEA line(A6),A0⓪*MOVE x(A6),D2⓪*BNE notzer⓪*MOVEQ #'0',D0 ;x = 0.0⓪*JSR put⓪*BNE.L overfl⓪*MOVE.B RadixChar,D0⓪*JSR put⓪*BNE.L overfl⓪*MOVEQ #'0',D0⓪*MOVE n(A6),D1⓪*BEQ nozero⓪"!zeros JSR put⓪*BNE.L overfl⓪*SUBQ #1,D1⓪*BNE zeros⓪"!nozero CLR e(A6)⓪*BRA.L putexp⓪"!notzer BCLR #0,D2 ;jm 14.6.⓪*BEQ notneg⓪*MOVE D2,x(A6)⓪*MOVEQ #'-',D0⓪*JSR put⓪*BNE.L overfl⓪"⓪"!notneg JSR bintodezexp⓪*MOVE D2,e(A6)⓪*LEA x(A6),A0 ;x:=x/ten(e)⓪*MOVE.L (A0)+,(A3)+⓪*MOVE.L (A0),(A3)+⓪*MOVE D2,(A3)+⓪*SUBQ.L #2,A7⓪*MOVE.L A7,(A3)+ ;'valid'-Para; nur dummy, weil Overflow unmöglich⓪*JSR ten⓪*ADDQ.L #2,A7⓪*JSR @RDIV⓪*LEA x(A6),A2 ;0.1<=x<1.0⓪*MOVE.L -(A3),4(A2)⓪*MOVE.L -(A3),(A2)⓪*LEA e(A6),A1⓪*JSR norm ;0.1<=x<1.0⓪*MOVE n(A6),D0 ;Runden⓪*⓪*; zusätzlich zu Nachkommastellen haben wir e MOD 3 Vorkommastellen;⓪*; Rundung soll hinter der letzten ausgegebenen Ziffer erfolgen⓪*⓪*MOVEQ #0,D1 ; berechne e MOD 3⓪*MOVE e(A6),D1⓪*ADD #1235,D1⓪*DIVU #3,D1⓪*SWAP D1⓪)⓪*ADD D1,D0 ; addieren zur Gesamtstellenzahl⓪*ADDQ #1,D0⓪*CMPI #14,D0⓪*BLS okrund⓪*MOVEQ #14,D0⓪"!okrund ASL #3,D0⓪*LEA roundkonst,A0 ; dummy, um Weg-Optimierung zu verhindern⓪*LEA half,A0⓪*ADDA D0,A0⓪*MOVE.L (A0)+,(A3)+⓪*MOVE.L (A0),(A3)+⓪*LEA x(A6),A0⓪*MOVE.L (A0)+,(A3)+⓪*MOVE.L (A0),(A3)+⓪*JSR @RADD⓪*LEA x(A6),A2⓪*MOVE.L -(A3),4(A2)⓪*MOVE.L -(A3),(A2)⓪*LEA e(A6),A1⓪*JSR norm⓪ noRund LEA x(A6),A0 ;trunc(x) in 48-bit Mantisse⓪*MOVE.L (A0)+,D0⓪*MOVE.L (A0),D1⓪*SWAP D0⓪*MOVE D0,D2⓪*CLR D0⓪*SWAP D0⓪*⓪*ASR #3,D2⓪*BPL finis ;bei Exp >= 0 fertig⓪*NOT D2 ;Exp -1 ergibt Zählwert 0 in D2 (NEG D2, DEC D2)⓪*; SUBI #$0FFF,D2⓪*; BGT finis ;bei Exp > -1 fertig⓪*; NEG D2⓪"⓪"!shr LSR #1,D0⓪*ROXR.L #1,D1⓪*DBF D2,shr⓪*BCC finis ;evtl. aufrunden⓪*ADDQ.L #1,D1⓪*BCC finis⓪*ADDQ.W #1,D0⓪"!finis LEA line(A6),A0 ;1-3 Vorkommastellen berechnen⓪*MOVEQ #0,D5 ;Zaehler fuer ausgegebene Stellen⓪"!putvor JSR digit⓪*BNE.L overfl⓪*MOVEQ #0,D4⓪*MOVE e(A6),D4⓪*SUBQ #1,D4⓪*MOVE D4,e(A6)⓪*ADD #1233,D4⓪*DIVU #3,D4⓪*SWAP D4⓪*TST D4⓪*BNE putvor⓪*MOVE n(A6),D4⓪*BEQ putexp⓪*MOVE.L D0,D2⓪*MOVE.B RadixChar,D0⓪*JSR put⓪*BNE.L overfl⓪*MOVE.L D2,D0⓪"!putman JSR digit ;n Nachkommastellen berechnen⓪*BNE.L overfl⓪*SUBQ #1,D4⓪*BNE putman⓪"!putexp MOVEQ #'E',D0⓪*JSR put⓪*BNE.L overfl⓪*MOVEQ #'+',D0⓪*MOVE e(A6),D1⓪*BPL posit⓪*NEG D1⓪*MOVEQ #'-',D0⓪"!posit JSR put⓪*BNE.L overfl⓪*MOVE D1,D0⓪*MOVEQ #'0',D1⓪*DIVU #1000,D0⓪*OR D1,D0⓪*JSR put⓪*BNE.L overfl⓪*CLR D0⓪*SWAP D0⓪*DIVU #100,D0⓪*OR D1,D0⓪*JSR put⓪*BNE overfl⓪*CLR D0⓪*SWAP D0⓪*DIVU #10,D0⓪*OR D1,D0⓪*JSR put⓪*BNE overfl⓪*SWAP D0⓪*OR D1,D0⓪*JSR put⓪*BNE overfl⓪"END;⓪"insSpc (lin,line.l,space);⓪"ASSEMBLER⓪*BRA ende⓪"overfl TRAP #6⓪*DC.W StringOverflow-$4000 ; string overflow⓪"ende MOVEM.L (A7)+,D3-D6⓪"END⓪ END ConvEng;⓪ ⓪ (*$L+*)⓪ PROCEDURE ConvFix(x:LONGREAL; space,n:CARDINAL; VAR lin: ARRAY OF CHAR);⓪ VAR line:LStr;⓪$e:INTEGER;⓪ BEGIN⓪"ASSEMBLER⓪*MOVEM.L D3-D6,-(A7)⓪*⓪*MOVE.L lin(A6),line.p(A6)⓪*MOVE.W lin+4(A6),line.h(A6) ; HIGH (lin)⓪*CLR.W line.l(A6)⓪*⓪*LEA line(A6),A0⓪*MOVE x(A6),D2⓪*BNE notzer⓪*MOVEQ #'0',D0 ;x = 0.0⓪*JSR put⓪*BNE.L overfl⓪*MOVE.B RadixChar,D0⓪*JSR put⓪*BNE.L overfl⓪*MOVEQ #'0',D0⓪*MOVE n(A6),D1⓪*BEQ nozero⓪"!zeros JSR put⓪*BNE.L overfl⓪*SUBQ #1,D1⓪*BNE zeros⓪"!nozero BRA.L ende⓪"!notzer BCLR #0,D2 ;jm 14.6.⓪*BEQ notneg⓪*MOVE D2,x(A6)⓪*MOVEQ #'-',D0⓪*JSR put⓪*BNE.L overfl⓪"!notneg JSR bintodezexp⓪*MOVE D2,e(A6)⓪*LEA x(A6),A0 ;x:=x/ten(e)⓪*MOVE.L (A0)+,(A3)+⓪*MOVE.L (A0),(A3)+⓪*MOVE D2,(A3)+⓪*SUBQ.L #2,A7⓪*MOVE.L A7,(A3)+ ;'valid'-Para; nur dummy, weil Overflow unmöglich⓪*JSR ten⓪*ADDQ.L #2,A7⓪*JSR @RDIV⓪*LEA x(A6),A2⓪*MOVE.L -(A3),4(A2)⓪*MOVE.L -(A3),(A2)⓪*LEA e(A6),A1⓪*JSR norm⓪*MOVE n(A6),D0 ;Runden: ausgegeben werden n Nachkomma-⓪?; stellen und e Vorkommastellen!⓪?; Auf nomalisierte Mantisse daher hinter⓪?; der (n+e). Stelle 0.5 addieren!⓪*ADD e(A6),D0⓪*BMI norund⓪*CMPI #14,D0⓪*BLS okrund⓪*MOVEQ #14,D0⓪"!okrund ASL #3,D0⓪*LEA roundkonst,A0 ; dummy, um Weg-Optimierung zu verhindern⓪*LEA half,A0⓪*ADDA D0,A0⓪*MOVE.L (A0)+,(A3)+⓪*MOVE.L (A0),(A3)+⓪*LEA x(A6),A0⓪*MOVE.L (A0)+,(A3)+⓪*MOVE.L (A0),(A3)+⓪*JSR @RADD⓪*LEA x(A6),A2⓪*MOVE.L -(A3),4(A2)⓪*MOVE.L -(A3),(A2)⓪*LEA e(A6),A1⓪*JSR norm⓪"!norund LEA x(A6),A0 ;trunc(x) in 48-bit Mantisse⓪*MOVE.L (A0)+,D0⓪*MOVE.L (A0),D1⓪*SWAP D0⓪*MOVE D0,D2⓪*CLR D0⓪*SWAP D0⓪*⓪*ASR #3,D2⓪*BPL finis ;bei Exp >= 0 fertig⓪*NOT D2 ;Exp -1 ergibt Zählwert 0 in D2 (NEG D2, DEC D2)⓪*; SUBI #$0FFF,D2⓪*; BGT finis ;bei Exp > -1 fertig⓪*; NEG D2⓪"⓪"!shr LSR #1,D0⓪*ROXR.L #1,D1⓪*DBF D2,shr⓪*BCC finis ;evtl. aufrunden⓪*ADDQ.L #1,D1⓪*BCC finis⓪*ADDQ.W #1,D0⓪"!finis LEA line(A6),A0⓪*MOVEQ #0,D5⓪*TST e(A6)⓪*BLE vork0⓪"!vork JSR digit⓪*BNE.L overfl⓪*SUBQ #1,e(A6)⓪*BGT vork⓪*BRA decpt⓪"!vork0 MOVE.L D0,D2⓪*MOVEQ #'0',D0⓪*JSR put⓪*BNE.L overfl⓪*MOVE.L D2,D0⓪"!decpt MOVE n(A6),D4⓪*BLE ende⓪*MOVE.L D0,D2⓪*MOVE.B RadixChar,D0⓪*JSR put⓪*BNE.L overfl⓪*MOVE.L D2,D0⓪"!putman TST e(A6)⓪*BGE putmdg⓪*ADDQ #1,e(A6)⓪*MOVE.L D0,D2⓪*MOVEQ #'0',D0⓪*JSR put⓪*BNE.L overfl⓪*MOVE.L D2,D0⓪*SUBQ #1,D4⓪*BGT putman⓪*BRA ende⓪"!putmdg JSR digit⓪*BNE overfl⓪*SUBQ #1,D4⓪"!ende BGT putmdg⓪"⓪"END;⓪"insSpc (lin,line.l,space);⓪"ASSEMBLER⓪*BRA ende0⓪"overfl TRAP #6⓪*DC.W StringOverflow-$4000 ; string overflow⓪"ende0 MOVEM.L (A7)+,D3-D6⓪"END⓪ END ConvFix;⓪((* <-- 68000 *) *)⓪ ⓪ (*$? M68881 OR A68881:⓪ ⓪ (*$L+*)⓪ ⓪ PROCEDURE CFloat(v:LONGREAL;VAR mpos,epos : BOOLEAN;kfact : INTEGER;⓪1VAR decstr : ARRAY OF CHAR;⓪1VAR exponi : INTEGER);⓪ ⓪ VAR ostr : ARRAY[0..2] OF LONGINT;⓪$lepos: BOOLEAN;⓪ ⓪ BEGIN⓪"ASSEMBLER⓪(; WIRD NICHT BENUTZT!? MOVE.W kfact(A6),D0 ;Dynamic k-factor⓪"(*$? M68881:⓪(FMOVE.L FPCR,D1⓪(FMOVE.L #0,FPCR ; keine Exceptions auslösen⓪(FMOVE.D v(A6),FP0⓪(LEA ostr(A6),A0⓪(FMOVE.P FP0,(A0){17}⓪(FMOVE.L D1,FPCR⓪"*)⓪"(*$? A68881:⓪ !movl1 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ movl1⓪(SUBQ.B #2,D0⓪(BEQ noError⓪(JSR FPUError⓪ noError⓪(MOVE.W #$5400,fpcmd ; FMOVE.D v(A6),FP0⓪ !movl2 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ movl2⓪(MOVE.L v(A6),fpop⓪(TST.W fpstat⓪(MOVE.L v+4(A6),fpop⓪ !movl22 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ movl22⓪(LEA ostr(A6),A0⓪(MOVE.W #$6C11,fpcmd ;FMOVE.P FP0,(A0){#17}⓪ !movl3 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ movl3⓪(MOVE.L fpop,(A0)+⓪(TST.W fpstat⓪(MOVE.L fpop,(A0)+⓪(TST.W fpstat⓪(MOVE.L fpop,(A0)⓪(TST.W fpstat⓪(SUBQ.L #8,A0⓪"*)⓪(CMPI.B #$A,3(A0) ; Coprozessorfehler abfangen (A ~ 10)⓪(BNE no10pot⓪(MOVE.B #1,3(A0)⓪ !no10pot⓪(MOVEA.L mpos(A6),A1⓪(CLR.W (A1)⓪(BTST.B #7,(A0)⓪(BNE m_pos⓪(MOVE.W #1,(A1)⓪(MOVEQ #1,D2⓪ !m_pos MOVEA.L epos(A6),A1⓪(CLR.W (A1)⓪(CLR.W lepos(A6)⓪(BTST.B #6,(A0)⓪(BNE e_pos⓪(MOVE.W #1,lepos(A6)⓪(MOVE.W #1,(A1)⓪ !e_pos⓪(ADDA.W #12,A0 ; (A0) := ostr{12+}⓪(MOVEA.L decstr(A6),A1 ; A1 := ADR(decstr)⓪(MOVEA.L A1,A2⓪(ADDA.W #17,A2 ; (A2) := decstr{17+}⓪(MOVEQ #7,D0 ; count := 8⓪(; UNPACK scheint nicht richtig zu laufen (Errata-Sheet nachschauen !)⓪ !unplp ; UNPK -(A0),-(A2),#48⓪E; unpack mantissa⓪(CLR.W D1⓪(MOVE.B -(A0),D1⓪(LSL.W #4,D1⓪(LSR.B #4,D1⓪(ADD.W #$3030,D1⓪(MOVE.B D1,-(A2)⓪(LSR.W #8,D1⓪(MOVE.B D1,-(A2)⓪ (* MOVE.W D1,-(A2) Durch die beiden Moves ersetzt 19.08. MR *)⓪(DBRA D0,unplp⓪(MOVE.B -(A0),D1⓪(ANDI.B #$0F,D1⓪(ADD.B #$30,D1⓪(MOVE.B D1,-(A2)⓪(MOVEA.L A1,A2 ; unpack exponent⓪(ADDA.W #20,A2⓪(SUBQ.L #1,A0⓪(CLR.W D1⓪(MOVE.B -(A0),D1⓪(CLR.W D2⓪(MOVE.B D1,D2⓪(LSR.B #4,D2⓪(MULU #10,D2⓪(LSL.W #4,D1⓪(LSR.B #4,D1⓪(CLR.W D0⓪(MOVE.B D1,D0⓪(ADD.W D2,D0⓪(ADD.W #$3030,D1⓪(MOVE.W D1,-(A2)⓪(MOVE.B -(A0),D1⓪(ANDI.B #$F,D1⓪(MOVE.B D1,D2⓪(MULU #100,D2⓪(ADD.W D2,D0⓪(ADD.B #$30,D1⓪(MOVE.B D1,-(A2)⓪(TST.W lepos(A6)⓪(BNE e2_pos⓪(NEG.W D0⓪ !e2_pos MOVEA.L exponi(A6),A0⓪(MOVE.W D0,(A0)⓪"END;⓪ END CFloat;⓪ ⓪ ⓪ (* neue Routinen von GS: *)⓪ ⓪ (*$L-*)⓪ PROCEDURE getExp(r : LONGREAL) : INTEGER;⓪ ⓪"BEGIN⓪$ASSEMBLER⓪ (*$? M68881:⓪(FMOVE.L FPCR,D0⓪(FMOVE.L #0,FPCR ; keine Exceptions auslösen⓪(FABS.D -(A3),FP0⓪(FLOG10.X FP0⓪(FMOVE.W FP0,(A3)+⓪(FMOVE.L D0,FPCR⓪ *)⓪ (*$? A68881:⓪%l0 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ l0⓪(SUBQ.B #2,D0⓪(BEQ noError⓪(JSR FPUError⓪%noError:⓪(MOVE.W #$5418,fpcmd ; FABS.D <ea>,FP0⓪(MOVE.L -(A3),D2⓪(MOVE.L -(A3),D1⓪(MOVE.W fpstat,D0⓪(SUBQ.B #8,D0⓪(BNE Error⓪(MOVE.L D1,fpop⓪(TST.W fpstat⓪(MOVE.L D2,fpop⓪%l5 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ l5⓪(MOVE.W #$0015,fpcmd ; FLOG10.X FP0⓪%l2 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ l2⓪(SUBQ.B #2,D0⓪(BNE Error⓪(MOVE.W #$7000,fpcmd ; FMOVE.W FP0,<ea>⓪%l3 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ l3⓪(SUBQ.B #2,D0⓪(BNE Error⓪(MOVE.W fpop,(A3)+⓪%l4 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ l4⓪(SUBQ.B #2,D0⓪(BNE Error⓪(RTS⓪%Error⓪(JSR FPUError⓪(CLR.W (A3)+⓪ *)⓪$END⓪"END getExp;⓪ (*$L+*)⓪ ⓪ PROCEDURE ConvFloat( v : LONGREAL;⓪8spc, n : CARDINAL;⓪4VAR str : ARRAY OF CHAR);⓪ ⓪"VAR⓪"⓪$len, numLen : CARDINAL;⓪$numStr : ARRAY [0..19] OF CHAR;⓪$epos, mpos : BOOLEAN;⓪$expon : INTEGER;⓪$kfact,⓪$cptr, i : CARDINAL;⓪$over,⓪$fatal : BOOLEAN;⓪$⓪"BEGIN⓪$fatal := FALSE;⓪$over := FALSE;⓪$len := HIGH(str) + 1;⓪$IF spc > len THEN⓪&over := TRUE;⓪&spc := len⓪$END;⓪$IF n < 17 THEN⓪&kfact := INTEGER(n) + 1⓪$ELSE⓪&kfact := 17⓪$END;⓪$cFloat(v, mpos, epos, kfact, numStr, expon);⓪$numLen := 7 + n ; (* x.E+xxx + <n> *)⓪$IF ~mpos THEN⓪&INC(numLen)⓪$END;⓪$IF spc < numLen THEN⓪&IF numLen > len THEN⓪(over := TRUE;⓪(fatal := TRUE⓪&ELSE⓪(cptr := 0⓪&END⓪$ELSE⓪&cptr := spc - numLen⓪$END;⓪$IF ~fatal THEN⓪&IF cptr > 0 THEN⓪(FOR i := 0 TO cptr - 1 DO⓪*str[i] := ' '⓪(END⓪&END;⓪&IF ~mpos THEN⓪(str[cptr] := '-';⓪(INC(cptr)⓪&END;⓪&str[cptr] := numStr[0];⓪&INC(cptr);⓪&str[cptr] := '.';⓪&INC(cptr);⓪&FOR i := 1 TO n DO⓪(IF i < 17 THEN⓪*str[cptr] := numStr[i]⓪(ELSE⓪*str[cptr] := '0'⓪(END;⓪(INC(cptr)⓪&END;⓪&str[cptr] := 'E';⓪&INC(cptr);⓪&IF epos THEN⓪(str[cptr] := '+'⓪&ELSE⓪(str[cptr] := '-'⓪&END;⓪&INC(cptr);⓪&FOR i := 17 TO 19 DO⓪(str[cptr] := numStr[i];⓪(INC(cptr)⓪&END;⓪&IF cptr < len THEN⓪(str[cptr] := 0C⓪&END⓪$ELSE (* IF ~fatal *)⓪&FOR i := 0 TO len - 1 DO⓪(str[i] := '?'⓪&END⓪$END;⓪$IF over THEN⓪&ASSEMBLER⓪2TRAP #6⓪2DC.W -8-$4000⓪&END⓪$END⓪"END ConvFloat;⓪"⓪ ⓪ PROCEDURE ConvEng( v : LONGREAL;⓪6spc, n : CARDINAL;⓪2VAR str : ARRAY OF CHAR);⓪ ⓪"VAR⓪"⓪$len,⓪$numLen,⓪$deccnt : CARDINAL;⓪$numStr : ARRAY [0..19] OF CHAR;⓪$istr : ARRAY [1..3] OF CHAR;⓪$normex,⓪$expon : INTEGER;⓪$epos, mpos : BOOLEAN;⓪$kfact,⓪$cptr,⓪$i, vork : CARDINAL;⓪$over,⓪$fatal : BOOLEAN;⓪ ⓪"BEGIN⓪$fatal := FALSE;⓪$over := FALSE;⓪$len := HIGH(str) + 1;⓪$IF spc > len THEN⓪&over := TRUE;⓪&spc := len⓪$END;⓪$IF ABS (v) = 0R THEN⓪&vork:= 1;⓪&normex:= 0⓪$ELSE⓪&expon := getExp(v);⓪&normex := expon;⓪&IF normex < 0 THEN⓪(normex := normex - 2⓪&END;⓪&normex := (normex DIV 3) * 3;⓪&vork := expon - normex + 1;⓪$END;⓪$IF (vork + n) < 17 THEN⓪&kfact := vork + n⓪$ELSE⓪&kfact := 17⓪$END;⓪$cFloat(v, mpos, epos, kfact, numStr, expon);⓪$numLen := 7 + vork + n ; (* x..x. + <n> + E+xxxx *)⓪$IF ~mpos THEN⓪&INC(numLen)⓪$END;⓪$IF spc < numLen THEN⓪&IF numLen > len THEN⓪(over := TRUE;⓪(fatal := TRUE⓪&ELSE⓪(cptr := 0⓪&END⓪$ELSE⓪&cptr := spc - numLen⓪$END;⓪$IF ~fatal THEN⓪&IF cptr > 0 THEN⓪(FOR i := 0 TO cptr - 1 DO⓪*str[i] := ' '⓪(END⓪&END;⓪&IF ~mpos THEN⓪(str[cptr] := '-';⓪(INC(cptr)⓪&END;⓪&deccnt := 0;⓪&FOR i := vork TO 1 BY -1 DO⓪(str[cptr] := numStr[deccnt];⓪(INC(cptr);⓪(INC(deccnt)⓪&END;⓪&str[cptr] := '.';⓪&INC(cptr);⓪&FOR i := 1 TO n DO⓪(IF deccnt < 17 THEN⓪*str[cptr] := numStr[deccnt]⓪(ELSE⓪*str[cptr] := '0'⓪(END;⓪(INC(cptr);⓪(INC(deccnt)⓪&END;⓪&str[cptr] := 'E';⓪&INC(cptr);⓪&IF normex < 0 THEN⓪(str[cptr] := '-';⓪(normex := -normex⓪&ELSE⓪(str[cptr] := '+'⓪&END;⓪&INC(cptr);⓪&str[cptr] := '0';⓪&INC(cptr);⓪&ConvInt(normex, 3, istr);⓪&FOR i := 1 TO 3 DO⓪(IF istr[i] = ' ' THEN⓪*str[cptr] := '0'⓪(ELSE⓪*str[cptr] := istr[i]⓪(END;⓪(INC(cptr)⓪&END;⓪&IF cptr < len THEN⓪(str[cptr] := 0C⓪&END⓪$ELSE (* IF ~fatal *)⓪&FOR i := 0 TO len - 1 DO⓪(str[i] := '?'⓪&END⓪$END;⓪$IF over THEN⓪&ASSEMBLER⓪2TRAP #6⓪2DC.W -8-$4000⓪&END⓪$END⓪"END ConvEng;⓪"⓪ ⓪ PROCEDURE ConvFix( v : LONGREAL;⓪6spc, n : CARDINAL;⓪2VAR str : ARRAY OF CHAR);⓪ ⓪"VAR⓪"⓪$len,⓪$numLen : CARDINAL;⓪$numStr : ARRAY [0..19] OF CHAR;⓪$kfact,⓪$deccnt,⓪$expon : INTEGER;⓪$epos, mpos : BOOLEAN;⓪$cptr,⓪$i, vork : CARDINAL;⓪$over,⓪$fatal : BOOLEAN;⓪ ⓪"BEGIN⓪$fatal := FALSE;⓪$over := FALSE;⓪$len := HIGH(str) + 1;⓪$IF spc > len THEN⓪&over := TRUE;⓪&spc := len⓪$END;⓪$IF ABS (v) = 0R THEN⓪&kfact := n + 1;⓪$ELSE⓪&expon := getExp(v);⓪&kfact := expon + INTEGER(n) + 1;⓪$END;⓪$IF kfact > 17 THEN⓪&kfact := 17⓪$END;⓪$IF kfact > 0 THEN⓪&cFloat(v, mpos, epos, kfact, numStr, expon)⓪$END;⓪$IF expon < 0 THEN⓪&vork := 1⓪$ELSE⓪&vork := 1 + expon⓪$END;⓪$numLen := 1 + vork + n ; (* x..x. + <n> *)⓪$IF ~mpos THEN⓪&INC(numLen)⓪$END;⓪$IF spc < numLen THEN⓪&IF numLen > len THEN⓪(over := TRUE;⓪(fatal := TRUE⓪&ELSE⓪(cptr := 0⓪&END⓪$ELSE⓪&cptr := spc - numLen⓪$END;⓪$IF ~fatal THEN⓪&IF cptr > 0 THEN⓪(FOR i := 0 TO cptr-1 DO⓪*str[i] := ' '⓪(END⓪&END;⓪&IF ~mpos THEN⓪(str[cptr] := '-';⓪(INC(cptr)⓪&END;⓪&IF expon < 0 THEN⓪(deccnt := expon⓪&ELSE⓪(deccnt := 0⓪&END;⓪&FOR i := vork TO 1 BY -1 DO⓪(IF ~(deccnt < 0) AND (deccnt < 17) THEN⓪*str[cptr] := numStr[deccnt]⓪(ELSE⓪*str[cptr] := '0'⓪(END;⓪(INC(cptr);⓪(INC(deccnt)⓪&END;⓪&str[cptr] := '.';⓪&INC(cptr);⓪&FOR i := 1 TO n DO⓪(IF ~(deccnt < 0) AND (deccnt < 17) THEN⓪*str[cptr] := numStr[deccnt]⓪(ELSE⓪*str[cptr] := '0'⓪(END;⓪(INC(cptr);⓪(INC(deccnt)⓪&END;⓪&IF cptr < len THEN⓪(str[cptr] := 0C⓪&END⓪$ELSE (* IF ~fatal *)⓪&FOR i := 0 TO len - 1 DO⓪(str[i] := '?'⓪&END⓪$END;⓪$IF over THEN⓪&ASSEMBLER⓪2TRAP #6⓪2DC.W -8-$4000⓪&END⓪$END⓪"END ConvFix;⓪ ⓪ (* noch eingeklammert, könnte aber mal übernommen werden!⓪ ⓪((****************************************************************************)⓪((* *)⓪((* C O N V E R T - 6 8 0 2 0 *)⓪((* *)⓪((* Errorchecks eingebaut, mehere kleine Fehler beseitigt, zum Teil *)⓪((* neu programmiert. (GS) *)⓪((* *)⓪((****************************************************************************)⓪(⓪0⓪((*$L-*)⓪(PROCEDURE getExp(r : REAL) : INTEGER;⓪9⓪*BEGIN⓪,ASSEMBLER⓪8FABS.D -(A3),FP0 ; kein Runtime-Error möglich⓪8FLOG10.X FP0⓪8FMOVE.W FP0,(A3)+⓪,END⓪*END getExp;⓪((*$L+*)⓪9⓪9⓪(PROCEDURE cFloat( r : REAL; (* stark geändert GS *)⓪9VAR mpos, epos : BOOLEAN;⓪=kfaktor : CARDINAL;⓪9VAR decstr : ARRAY OF CHAR;⓪9VAR exponent : INTEGER );⓪(⓪*(* decstr hat folgenden Aufbau : *)⓪*(* Der String ist 20 Zeichen lang, linksbündig die Mantisse mit kfaktor *)⓪*(* signifikanten Stellen, rechtsbündig der dreistellige Exponent *)⓪*⓪*VAR⓪*⓪,BCDst : ARRAY[0..2] OF LONGINT;⓪(⓪*BEGIN⓪,ASSEMBLER⓪8MOVE kfaktor(A6),D0⓪8FMOVE.D r(A6),FP0⓪8LEA BCDst(A6),A0⓪8FMOVE.P FP0,(A0){D0}⓪8MOVEA.L mpos(A6),A2⓪8CLR (A2)⓪8BTST.B #7,(A0) ; sign of mantissa⓪8BNE m_neg⓪8MOVE #1,(A2)⓪.⓪.!m_neg MOVEA.L epos(A6),A2⓪8CLR (A2)⓪8BTST.B #6,(A0) ; sign of exponent⓪8BNE e_neg⓪8MOVE #1,(A2)⓪.⓪.!e_neg MOVEA.L decstr(A6),A1⓪8ADDA.W D0,A1 ; A1 after last digit⓪8ADDQ #4,A0 ; A0 points after first mantissa dig.⓪8MOVE D0,D1⓪8LSR #1,D1⓪8ADDA.W D1,A0 ; A0 points after last mantissa digit⓪8SUBQ #1,D0⓪8BTST #0,D0⓪8BEQ cont1⓪8⓪8MOVE.B -(A0),D1⓪8LSR #4,D1⓪8ADD.B #'0',D1⓪8MOVE.B D1,-(A1)⓪8⓪.!cont1 MOVE D0,D1⓪8LSR #1,D1⓪8BRA entry⓪8⓪.!unploop UNPK -(A0),-(A1),#$3030⓪.!entry DBRA D1,unploop⓪8⓪8MOVE.B -(A0),D1⓪8ANDI #$0F,D1⓪8ADD.B #'0',D1⓪8MOVE.B D1,-(A1)⓪8⓪.!done MOVEA.L decstr(A6),A1⓪8LEA 20(A1),A1⓪8LEA BCDst(A6),A0⓪8ADDQ #2,A0⓪8UNPK -(A0),-(A1),#$3030⓪8⓪8MOVE.B -(A0),D1⓪8ANDI #$0F,D1⓪8ADD.B #'0',D1⓪8MOVE.B D1,-(A1)⓪-⓪8MOVEA.L decstr(A6),A1⓪8LEA 17(A1),A1⓪8⓪8MOVEQ #0,D0⓪8MOVEQ #0,D1⓪8MOVEQ #2,D2⓪8⓪0!Loop MOVE.B (A1)+,D0⓪8SUB.B #'0',D0⓪8MULU #10,D1⓪8ADD D0,D1⓪8DBRA D2,Loop⓪8⓪8TST (A2)⓪8BNE e_pos2⓪8NEG D1⓪/!e_pos2 MOVEA.L exponent(A6),A0⓪8MOVE D1,(A0)⓪-END;⓪+END cFloat;⓪0⓪*⓪(PROCEDURE ConvToReal( get : GetProc;⓪=VAR info : GetInfo;⓪=VAR valid : BOOLEAN ) : REAL;⓪(⓪*VAR⓪*⓪,mneg, eneg,⓪,isdigit : BOOLEAN;⓪,i : CARDINAL;⓪,exp : INTEGER;⓪,c : CHAR;⓪,x : REAL;⓪,⓪,⓪*BEGIN⓪,ASSEMBLER⓪8MOVE.L D3,-(A7)⓪8BRA start⓪8⓪.!getchr MOVE.L A0,-(A7)⓪8MOVE.L info(A6),(A3)+⓪8MOVE.L get(A6),A0⓪8JSR (A0)⓪8MOVE.L (A7)+,A0⓪8MOVE.L info(A6),A1⓪8MOVEQ #0,D0⓪8MOVE.B GetInfo.ch(A1),D0⓪8MOVE.B D0,c(A6)⓪8SUBI.B #'0',D0⓪8CMPI.B #9,D0⓪8SLS D2⓪8MOVE.B D2,isdigit(A6)⓪8RTS⓪8⓪.!mulx10 (* x in FP0 *)⓪8FMUL.W #10,FP0⓪8MOVEQ #0,D0⓪8MOVE.B c(A6),D0⓪8SUBI.B #'0',D0⓪8FADD.W D0,FP0⓪8RTS⓪8⓪.!start MOVE.L valid(A6),A1⓪8CLR (A1)⓪.!skipspc BSR getchr⓪8CMPI.B #' ',c(A6)⓪8BEQ skipspc⓪8CMPI.B #9,c(A6) ; TAB⓪8BEQ skipspc⓪8⓪8CMPI.B #'-',c(A6)⓪8SEQ mneg(A6)⓪8BNE numneg⓪8BSR getchr⓪.!numneg CMPI.B #'+',c(A6)⓪8BNE numpos⓪8BSR getchr⓪.⓪.!numpos FMOVE.W #0,FP0⓪8⓪8CLR exp(A6)⓪.!mant1 TST.B isdigit(A6)⓪8BEQ point⓪8MOVE.L valid(A6),A1⓪8MOVE #1,(A1)⓪8BSR mulx10⓪8BSR getchr⓪8BRA mant1⓪.!point MOVE.B c(A6),D0⓪8CMP.B RadixChar,D0⓪8BNE expon⓪8BSR getchr⓪.!mant2 TST.B isdigit(A6)⓪8BEQ expon⓪8MOVE.L valid(A6),A1⓪8MOVE #1,(A1)⓪8BSR mulx10⓪8SUBQ #1,exp(A6)⓪.!dont1 BSR getchr⓪8BRA mant2⓪.!expon CMPI.B #'E',c(A6)⓪8BEQ expon0⓪8CMPI.B #'e',c(A6)⓪8BNE return⓪.!expon0 BSR getchr⓪8CLR eneg(A6)⓪8CMPI.B #'-',c(A6)⓪8SEQ eneg(A6)⓪8BNE noeneg⓪8BSR getchr⓪.!noeneg CMPI.B #'+',c(A6)⓪8BNE noepos⓪8BSR getchr⓪.!noepos CLR D3⓪.!expon1 TST.B isdigit(A6)⓪8BEQ expon2⓪8MULU #10,D3⓪8MOVE.B c(A6),D1⓪8ANDI #$F,D1⓪8ADD D1,D3⓪8BSR getchr⓪8BRA expon1⓪.⓪.!expon2 TST.B eneg(A6)⓪8BEQ expon3⓪8NEG D3⓪.!expon3 ADD exp(A6),D3⓪8MOVE D3,D0⓪8BPL testex⓪8NEG D0⓪.!testex CMPI #307,D0⓪8BLE expon4⓪8MOVE.L valid(A6),A1⓪8CLR (A1)⓪8⓪.!expon4 MOVE D3,exp(A6)⓪.!return TST.B mneg(A6)⓪8BEQ return1⓪8FTST.X FP0⓪8FBEQ return1⓪8FNEG.X FP0⓪.!return1 MOVE.L (A7)+,D3⓪8FTENTOX.W exp(A6),FP1⓪8FMUL.X FP1,FP0⓪8FMOVE.D FP0,x(A6)⓪8FMOVE.L FPSR,D0⓪8AND.B #$40,D0⓪8BEQ ok⓪8MOVE.L valid(A6),A1⓪8CLR (A1)⓪8FMOVE.L #$00,FPSR⓪.!ok ; ubu 31.5.88⓪L; GS 7.9.88⓪,END;⓪,RETURN x⓪*END ConvToReal;⓪(⓪(⓪(PROCEDURE ConvFloat( v : REAL;⓪@spc, n : CARDINAL;⓪<VAR str : ARRAY OF CHAR);⓪(⓪*VAR⓪*⓪,len, numLen : CARDINAL;⓪,numStr : ARRAY [0..19] OF CHAR;⓪,epos, mpos : BOOLEAN;⓪,expon : INTEGER;⓪,kfact,⓪,cptr, i : CARDINAL;⓪,over,⓪,fatal : BOOLEAN;⓪,⓪*BEGIN⓪,fatal := FALSE;⓪,over := FALSE;⓪,len := HIGH(str) + 1;⓪,IF spc > len THEN⓪.over := TRUE;⓪.spc := len⓪,END;⓪,IF n < 17 THEN⓪.kfact := INTEGER(n) + 1⓪,ELSE⓪.kfact := 17⓪,END;⓪,cFloat(v, mpos, epos, kfact, numStr, expon);⓪,numLen := 7 + n ; (* x.E+xxx + <n> *)⓪,IF ~mpos THEN⓪.INC(numLen)⓪,END;⓪,IF spc < numLen THEN⓪.IF numLen > len THEN⓪0over := TRUE;⓪0fatal := TRUE⓪.ELSE⓪0cptr := 0⓪.END⓪,ELSE⓪.cptr := spc - numLen⓪,END;⓪,IF ~fatal THEN⓪.IF cptr > 0 THEN⓪0FOR i := 0 TO cptr - 1 DO⓪2str[i] := ' '⓪0END⓪.END;⓪.IF ~mpos THEN⓪0str[cptr] := '-';⓪0INC(cptr)⓪.END;⓪.str[cptr] := numStr[0];⓪.INC(cptr);⓪.str[cptr] := '.';⓪.INC(cptr);⓪.FOR i := 1 TO n DO⓪0IF i < 17 THEN⓪2str[cptr] := numStr[i]⓪0ELSE⓪2str[cptr] := '0'⓪0END;⓪0INC(cptr)⓪.END;⓪.str[cptr] := 'E';⓪.INC(cptr);⓪.IF epos THEN⓪0str[cptr] := '+'⓪.ELSE⓪0str[cptr] := '-'⓪.END;⓪.INC(cptr);⓪.FOR i := 17 TO 19 DO⓪0str[cptr] := numStr[i];⓪0INC(cptr)⓪.END;⓪.IF cptr < len THEN⓪0str[cptr] := 0C⓪.END⓪,ELSE (* IF ~fatal *)⓪.FOR i := 0 TO len - 1 DO⓪0str[i] := '?'⓪.END⓪,END;⓪,IF over THEN⓪.ASSEMBLER⓪:TRAP #6⓪:DC.W -8-$4000⓪.END⓪,END⓪*END ConvFloat;⓪*⓪(⓪(PROCEDURE ConvEng( v : REAL;⓪>spc, n : CARDINAL;⓪:VAR str : ARRAY OF CHAR);⓪(⓪*VAR⓪*⓪,len,⓪,numLen,⓪,deccnt : CARDINAL;⓪,numStr : ARRAY [0..19] OF CHAR;⓪,istr : ARRAY [1..3] OF CHAR;⓪,normex,⓪,expon : INTEGER;⓪,epos, mpos : BOOLEAN;⓪,kfact,⓪,cptr,⓪,i, vork : CARDINAL;⓪,over,⓪,fatal : BOOLEAN;⓪(⓪*BEGIN⓪,fatal := FALSE;⓪,over := FALSE;⓪,len := HIGH(str) + 1;⓪,IF spc > len THEN⓪.over := TRUE;⓪.spc := len⓪,END;⓪,expon := getExp(v);⓪,normex := expon;⓪,IF normex < 0 THEN⓪.normex := normex - 2⓪,END;⓪,normex := (normex DIV 3) * 3;⓪,vork := expon - normex + 1;⓪,IF (vork + n) < 17 THEN⓪.kfact := vork + n⓪,ELSE⓪.kfact := 17⓪,END;⓪,cFloat(v, mpos, epos, kfact, numStr, expon);⓪,numLen := 7 + vork + n ; (* x..x. + <n> + E+xxxx *)⓪,IF ~mpos THEN⓪.INC(numLen)⓪,END;⓪,IF spc < numLen THEN⓪.IF numLen > len THEN⓪0over := TRUE;⓪0fatal := TRUE⓪.ELSE⓪0cptr := 0⓪.END⓪,ELSE⓪.cptr := spc - numLen⓪,END;⓪,IF ~fatal THEN⓪.IF cptr > 0 THEN⓪0FOR i := 0 TO cptr - 1 DO⓪2str[i] := ' '⓪0END⓪.END;⓪.IF ~mpos THEN⓪0str[cptr] := '-';⓪0INC(cptr)⓪.END;⓪.deccnt := 0;⓪.FOR i := vork TO 1 BY -1 DO⓪0str[cptr] := numStr[deccnt];⓪0INC(cptr);⓪0INC(deccnt)⓪.END;⓪.str[cptr] := '.';⓪.INC(cptr);⓪.FOR i := 1 TO n DO⓪0IF deccnt < 17 THEN⓪2str[cptr] := numStr[deccnt]⓪0ELSE⓪2str[cptr] := '0'⓪0END;⓪0INC(cptr);⓪0INC(deccnt)⓪.END;⓪.str[cptr] := 'E';⓪.INC(cptr);⓪.IF normex < 0 THEN⓪0str[cptr] := '-';⓪0normex := -normex⓪.ELSE⓪0str[cptr] := '+'⓪.END;⓪.INC(cptr);⓪.str[cptr] := '0';⓪.INC(cptr);⓪.ConvInt(normex, 3, istr);⓪.FOR i := 1 TO 3 DO⓪0IF istr[i] = ' ' THEN⓪2str[cptr] := '0'⓪0ELSE⓪2str[cptr] := istr[i]⓪0END;⓪0INC(cptr)⓪.END;⓪.IF cptr < len THEN⓪0str[cptr] := 0C⓪.END⓪,ELSE (* IF ~fatal *)⓪.FOR i := 0 TO len - 1 DO⓪0str[i] := '?'⓪.END⓪,END;⓪,IF over THEN⓪.ASSEMBLER⓪:TRAP #6⓪:DC.W -8-$4000⓪.END⓪,END⓪*END ConvEng;⓪*⓪(⓪(PROCEDURE ConvFix( v : REAL;⓪>spc, n : CARDINAL;⓪:VAR str : ARRAY OF CHAR);⓪(⓪*VAR⓪*⓪,len,⓪,numLen : CARDINAL;⓪,numStr : ARRAY [0..19] OF CHAR;⓪,kfact,⓪,deccnt,⓪,expon : INTEGER;⓪,epos, mpos : BOOLEAN;⓪,cptr,⓪,i, vork : CARDINAL;⓪,over,⓪,fatal : BOOLEAN;⓪(⓪*BEGIN⓪,fatal := FALSE;⓪,over := FALSE;⓪,len := HIGH(str) + 1;⓪,IF spc > len THEN⓪.over := TRUE;⓪.spc := len⓪,END;⓪,expon := getExp(v);⓪,kfact := expon + INTEGER(n) + 1;⓪,IF kfact > 17 THEN⓪.kfact := 17⓪,END;⓪,IF kfact > 0 THEN⓪.cFloat(v, mpos, epos, kfact, numStr, expon)⓪,END;⓪,IF expon < 0 THEN⓪.vork := 1⓪,ELSE⓪.vork := 1 + expon⓪,END;⓪,numLen := 1 + vork + n ; (* x..x. + <n> *)⓪,IF ~mpos THEN⓪.INC(numLen)⓪,END;⓪,IF spc < numLen THEN⓪.IF numLen > len THEN⓪0over := TRUE;⓪0fatal := TRUE⓪.ELSE⓪0cptr := 0⓪.END⓪,ELSE⓪.cptr := spc - numLen⓪,END;⓪,IF ~fatal THEN⓪.IF cptr > 0 THEN⓪0FOR i := 0 TO cptr-1 DO⓪2str[i] := ' '⓪0END⓪.END;⓪.IF ~mpos THEN⓪0str[cptr] := '-';⓪0INC(cptr)⓪.END;⓪.IF expon < 0 THEN⓪0deccnt := expon⓪.ELSE⓪0deccnt := 0⓪.END;⓪.FOR i := vork TO 1 BY -1 DO⓪0IF ~(deccnt < 0) AND (deccnt < 17) THEN⓪2str[cptr] := numStr[deccnt]⓪0ELSE⓪2str[cptr] := '0'⓪0END;⓪0INC(cptr);⓪0INC(deccnt)⓪.END;⓪.str[cptr] := '.';⓪.INC(cptr);⓪.FOR i := 1 TO n DO⓪0IF ~(deccnt < 0) AND (deccnt < 17) THEN⓪2str[cptr] := numStr[deccnt]⓪0ELSE⓪2str[cptr] := '0'⓪0END;⓪0INC(cptr);⓪0INC(deccnt)⓪.END;⓪.IF cptr < len THEN⓪0str[cptr] := 0C⓪.END⓪,ELSE (* IF ~fatal *)⓪.FOR i := 0 TO len - 1 DO⓪0str[i] := '?'⓪.END⓪,END;⓪,IF over THEN⓪.ASSEMBLER⓪:TRAP #6⓪:DC.W -8-$4000⓪.END⓪,END⓪*END ConvFix;⓪0⓪0⓪ (*****************************************************************************)⓪ (* *)⓪ (* E N D E (von GS) *)⓪ (* *)⓪ (*****************************************************************************)⓪ *)⓪ ⓪ (* <-- 68020 *) *)⓪ ⓪ (*$L-*)⓪ PROCEDURE ConvReal(x:LONGREAL; space,n:CARDINAL; VAR str: ARRAY OF CHAR);⓪ BEGIN⓪"(* Die folgende Würgerei hat den Zweck, daß das Scanning bei einem⓪#* 'string overflow'-Fehler den Aufrufer dieser Funktion erreicht. *)⓪"ASSEMBLER⓪(MOVE.L A6,-(A7)⓪ (*$? CompilerVersion > 3:⓪(LEA (A3),A6⓪ *)⓪ (*$? CompilerVersion <= 3:⓪(LEA -18(A3),A6⓪ *)⓪"END;⓪"IF (ABS(x)=0R) OR (FixToFloatMin<=ABS(X)) & (ABS(X)<=FixToFloatMax) THEN⓪$ASSEMBLER⓪(MOVE.L (A7)+,A6⓪(JMP ConvFix⓪$END⓪"ELSE⓪$ASSEMBLER⓪(MOVE.L (A7)+,A6⓪(JMP ConvFloat⓪$END⓪"END⓪ END ConvReal;⓪ ⓪ END Convert.⓪ ə
- (* $00003F7D$0000A3BE$00007F84$00008C8B$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$000096D2$FFF317C4$0000EB26$FFF317C4$00009F3E$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4$FFF317C4Ç$000009A5T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$0000A0EA$0000A150$000009BB$00000991$00009662$000096E2$00000984$000009B8$000009AB$000096DF$000009A5$0000963E$000096BF$00009EE9$0000A014$0000A06D¼Çâ*)
-
